leiru

½Ð°Ý¥ÎVBA¦p¦ó¼g¡A·Q¬ã¨s¬Ý¡A·PÁ±z

­ã´£³¡ªL

¦^´_ 11# leiru

Sub TEST()
Dim R&, Arr, T$, TT$, TS, xD, i&
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([D1], [D65536].End(xlUp)(2))
For i = 2 To UBound(Arr)
    If Arr(i, 1) <> "" Then xD(Arr(i, 1) & "") = ""
Next i
Arr = Range([A2], [A65536].End(xlUp)(2))
For i = 1 To UBound(Arr)
    TT = "": T = Replace(Arr(i, 1), "=", "+")
    If T = "" Then GoTo 101
    For Each TS In Split(T, "+")
        If TS <> "" And xD.Exists(TS & "") Then TT = TT & "¡B" & TS
    Next
    Arr(i, 1) = Mid(TT, 2)
101: Next i
[B2].Resize(UBound(Arr)) = Arr
End Sub


==================================

Andy2483

¦^´_ 12# ­ã´£³¡ªL

ÁÂÁ½׾Â,ÁÂÁ«e½ú
«á¾ÇÂǦ¹©«¾Ç²ß«e½úªº¤è®×,¤è®×¾Ç²ß¤ß±oµù¸Ñ¦p¤U,½Ð«e½ú¦A«ü¾É

°õ¦æ«e:

¤U¸ü (131.24 KB)

2023-5-31 11:20

°õ¦æµ²ªG:

¤U¸ü (140.79 KB)

2023-5-31 11:20

Option Explicit
Sub TEST()
Dim R&, Arr, T$, TT$, TS, xD, i&
'¡ô«Å§iÅܼÆ
Set xD = CreateObject("Scripting.Dictionary")
'¡ô¥OxDÅܼƬO ¦r¨å
Arr = Range([D1], [D65536].End(xlUp)(2))
'¡ô¥OArrÅܼƬO ¤Gºû°}¦C,¥HDÄæÀx¦s®æ­È±a¤J°}¦C
For i = 2 To UBound(Arr)
   If Arr(i, 1) <> "" Then xD(Arr(i, 1) & "") = ""
Next i
'¡ô³]¶¶°j°é±N°}¦C­È·íkey,item¬OªÅªº,¯Ç¤JxD¦r¨å¸Ì
Arr = Range([A2], [A65536].End(xlUp)(2))
'¡ô¥OArr°}¦C´«¸ËAÄæÀx¦s®æ­È(¤£§t¼ÐÃD¦C)
For i = 1 To UBound(Arr)
'¡ô³]¶¶°j°é
    TT = "": T = Replace(Arr(i, 1), "=", "+")
    '¡ô¥OTTÅܼƬO ªÅ¥Õ,¥OTÅܼƬO °}¦C­È¸m´« "=" ¬° "+"
    If T = "" Then GoTo 101
    '¡ô¦pªGTÅܼƬOªÅ¥Õ!´N¸õ¨ì¼Ð¥Ü101¦ì¸mÄ~Äò°õ¦æ(ªÅ¥Õ¤£³B²z)
    For Each TS In Split(T, "+")
    '¡ô³]³v¶µ°j°é!¥OTSÅܼƬO (TÅܼƥH"+"¤À³Î«áªº¤@ºû°}¦C)°}¦C­È
        If TS <> "" And xD.Exists(TS & "") Then TT = TT & "¡B" & TS
        '¡ô¦pªGTSÅܼƤ£¬OªÅ¥Õ,¥BTSÅܼƤ£¦bxD¦r¨å¸Ì?
        '¥OTSÅܼÆ(¦r¦ê)©ñ¦bTTÅܼÆ(¦r¦ê)«á¤è,¥H "¡B" ¶¡¹j
    Next
    Arr(i, 1) = Mid(TT, 2)
    '¡ô¥OTTÅܼƨú²Ä2¦r¥H«áªº¦r¤¸¼g¤JArr°}¦C¸Ì
101: Next i
[B2].Resize(UBound(Arr)) = Arr
'¡ô¥OArr°}¦C­È±q[B2]¶}©l¼g¤JÀx¦s®æ¸Ì
End Sub

Andy2483

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å,¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð

Option Explicit
Sub TEST_1() '¡ô
Dim Brr, Y, i&, T$, TT$, K
'¡ô«Å§iÅܼÆ
Set Y = CreateObject("Scripting.Dictionary")
'¡ô¥OYÅܼƬO ¦r¨å
Brr = Range([D1], [D65536].End(3))
'¡ô¥OBrrÅܼƬO ¤Gºû°}¦C,¥HDÄæÀx¦s®æ­È±a¤J°}¦C
For i = 2 To UBound(Brr)
   T = Trim(Brr(i, 1)): If T <> "" Then Y(T) = i
Next
'¡ô³]¶¶°j°é±N°}¦C­È·íkey,item¬OiÅܼÆ,¯Ç¤JY¦r¨å¸Ì
Brr = Range([A2], [A65536].End(3))
'¡ô¥OBrr°}¦C´«¸ËAÄæÀx¦s®æ­È(¤£§t¼ÐÃD¦C)
For i = 1 To UBound(Brr)
'¡ô³]¶¶°j°é
   T = Replace(Trim(Brr(i, 1)), "+", "=")
   '¡ô¥OTÅܼƬO°}¦C­È¥h°£ÀY§ÀªÅ¥Õ¦r¤¸«á,¦A¸m´«"+" ¬° "="
   If T = "" Then GoTo i01 Else: T = "=" & T & "="
   '¡ô¦pªGTÅܼƬOªÅ¦r¤¸,´N¤£³B²z¸õ¨ì¼Ð¥Üi01¦ì¸mÄ~Äò°õ¦æ,
   '§_«h´N¥OTÅܼƦb«e«á¦U¥]§¨¤@­Ó"="²Å¸¹ªº·s¦r¦ê
   For Each K In Y.keys
   '¡ô³]³v¶µ°j°é,¥OKÅܼƬOY¦r¨å¸Ìªº¤@key
      If InStr(T, "=" & K & "=") Then TT = TT & "¡B" & K
      '¡ô¦pªGTÅܼÆ(¦r¦ê)¸Ì¥]§t¤F (KÅܼƦb«e«á¦U¥]§¨¤@­Ó"="²Å¸¹)¦r¦ê
   Next
   Brr(i, 1) = Mid(TT, 2): TT = ""
   '¡ô¥OTTÅܼƪº²Ä2­Ó¦r¤¸¶}©lªº¦r¦ê¼g¤J°}¦C¸Ì(Âл\­ì°}¦C­È)
i01: Next
[B2].Resize(UBound(Brr)) = Brr
'¡ô¥OBrr°}¦C­È±q[B2]¶}©l¼g¤JÀx¦s®æ¸Ì
Set Y = Nothing: Erase Brr
'¡ô¥OÄÀ©ñÅܼÆ
End Sub