麻辣家族討論版版 - Powered by Discuz! Board

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

作者: s7659109 時間: 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))))

作者: 准提部林 時間: 2018-10-31 09:51

三個公式要合併成一個???
想用vba, 看公式沒用, 將需求絛件寫清楚, 上傳檔案!

作者: s7659109 時間: 2018-10-31 11:36

本帖最後由 s7659109 於 2018-10-31 11:38 編輯

回復 2# 准提部林
需求條件：公式已放入AA~AE,希望以數組+迴圈+條件判斷完成
附檔已上傳

作者: 准提部林 時間: 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

[attach]29611[/attach]

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)