­ã´£³¡ªL

¤T­Ó¤½¦¡­n¦X¨Ö¦¨¤@­Ó???
·Q¥Îvba, ¬Ý¤½¦¡¨S¥Î, ±N»Ý¨D¸l¥ó¼g²M·¡, ¤W¶ÇÀÉ®×!

­ã´£³¡ªL

¦^´_ 3# s7659109

Sub ±ø¥ó¨ú­È()
Dim Arr, Brr, xD, xR As Range, R&, T$, Th$
Set xD = CreateObject("Scripting.Dictionary")
For Each xR In Range([¬ì¥Ø¥N¸¹!R1], [¬ì¥Ø¥N¸¹!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)

¤U¸ü¦¸¼Æ: 17

2018-10-31 20:55