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

s7659109

請問以下三段公式，若轉換為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))))

准提部林

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

s7659109

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

准提部林

回復 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

Xl0000300(公式換vba).rar (13.62 KB)

下載次數: 17

2018-10-31 20:55