返回列表下一主題上一主題發帖

[發問] 請問以下三段公式，若轉換為vba 該如何撰寫（非用.Formula =“ ”）解決

s7659109

中學生 Rank: 2

帖子: 248
主題: 76
精華: 0
積分: 331
點名: 0
作業系統: XP
軟體版本: XP
閱讀權限: 20
性別: 男
來自: kaohsiung
註冊時間: 2013-6-10
最後登錄: 2020-7-3

1^# 跳轉到 » 正序看帖

打印

字體大小: tT

發表於 2018-10-30 15:40 | 只看該作者

[發問] 請問以下三段公式，若轉換為vba 該如何撰寫（非用.Formula =“ ”）解決

請問以下三段公式，若轉換為vba 判斷式，該如何撰寫（非用.Formula =“ ”）解決？

=IF(OR(MID(H2,2,1)="M",MID(H2,2,1)="L"),LEFT(H2,3),IF(LEN(TRIM(H2))=4,H2,TRIM(LEFT(H2, SEARCH(" ",H2,1)))&IF(I2="","",MID(I2,6,1))))

=TRIM(IFERROR(VLOOKUP(LEFT(K2,6),IF({1,0},科目代號!$X$2:$X$500,科目代號!$R$2:$R$500),2,),""))

=IF(LEFT(H2,1)="9",TRIM(H2),IF(I2="",LEFT(TRIM(H2),SEARCH(" ",H2,1)-1)&TRIM(MID(K2,2,1)&MID(K2,4,3)),LEFT(TRIM(H2),SEARCH(" ",H2,1)-1)&TRIM(MID(I2,6,1)&LEFT(J2,3))))

樓主熱帖

希望支持!

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-26

4^#

發表於 2018-10-31 20:55 | 只看該作者

回復 3# s7659109

Sub 條件取值()
Dim Arr, Brr, xD, xR As Range, R&, T$, Th$
Set xD = CreateObject("Scripting.Dictionary")
For Each xR In Range([科目代號!R1], [科目代號!R65536].End(xlUp))
If xR(1, 7) <> "" Then xD(xR(1, 7) & "#") = xR
If xR(1, 9) <> "" Then xD(xR(1, 9) & "$") = xR(1, 8)
Next

R = [data!H65536].End(xlUp).Row
Arr = [data!H1:K1].Resize(R)
ReDim Brr(1 To R, 1 To 5)
For i = 2 To R
Th = Split(Arr(i, 1), " ")(0)
'--------------------------------------
T = Th & Mid(Arr(i, 2), 6, 1)
If InStr("_ML", Mid(Th, 2, 1)) > 1 Then T = Left(Th, 3)
Brr(i - 1, 1) = T 'vba1
'-------------------------------------------
Brr(i - 1, 2) = Left(Arr(i, 3), 3) 'vba2
Brr(i - 1, 3) = xD(Left(Arr(i, 4), 4) & "#") & "" 'vba3
'---------------------------------------------
T = Th & Mid(Arr(i, 2), 6, 1) & Left(Arr(i, 3), 3)
If Arr(i, 2) = "" Then T = Th & Mid(Arr(i, 4), 2, 1) & Mid(Arr(i, 4), 4, 3)
If Left(Th, 1) = "9" Then T = Arr(i, 1)
Brr(i - 1, 4) = T 'vba4
'---------------------------------------------
Brr(i - 1, 5) = xD(Brr(i - 1, 4) & "$") & "" 'vba5
Next i
[AA2:AE2].Resize(R - 1) = Brr
End Sub