ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] Âà´«¤å¦r§Î¦¡·j´M

¯Â¤å¦r³B²z~~~

Sub TEST_A1()
Dim xU As Range, Arr, A, V, xR As Range, xD, T$
Set xD = CreateObject("Scripting.Dictionary")
Set xU = [¤u§@ªí1!d:w] '­Y¬O¸óÀÉ, ¥²¶·¥ý¥´¶}¸ÓÀÉ®×, ¦A«ü©w¤u§@ªí¤Î½d³ò
For Each A In Array("¥­Ås", "¥kÁ³±Û", "¥ªÁ³±Û")     
      For Each xR In xU.Find(A, Lookat:=xlWhole).MergeArea   'ª`·N:³o¬O¥H"¦X¨Ö®æ"§ì½d³ò
           xD(V & xR(3)) = xR(2)
    Next
    V = V + 1
Next
'---------------------------
Arr = Range([a1], [a65536].End(3))
For i = 5 To UBound(Arr)
    T = Replace(Replace(Arr(i, 1), "¢X", ""), "¥õ¨¤", "/")
    T = Split(Replace(Replace(T, "RR", "1R"), "LR", "2R") & "Âà", "Âà")(0)
    Arr(i - 4, 1) = xD(T)
Next i
[b5].Resize(UBound(Arr) - 4) = Arr
End Sub


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

TOP

¥»©«³Ì«á¥Ñ ­ã´£³¡ªL ©ó 2021-9-13 18:59 ½s¿è

¦^´_ 36# wayne0303

Sub TEST_A1()
Dim xU As Range, Arr, A, V, xR As Range, xD, T$
Set xD = CreateObject("Scripting.Dictionary")
Set xU = [¤u§@ªí1!f2:ad73]
For Each A In Array("¥­Ås", "¥kÁ³±Û", "¥ªÁ³±Û")
    For Each xR In xU.Find(A, Lookat:=xlWhole).Resize(1, 100)  '§ä¨ìÃöÁä¦r, ¦V¥kÂX®i100Äæ, ­Y¤£°÷¥Î¦Û§ï¤U(¦¹®É´N¤£¥ÎºÞ¦X¨Ö®æ¤F)  
        If xR(3) <> "" Then xD(V & xR(3)) = xR(2)
    Next
    V = V + 1
Next
'---------------------------
Arr = Range([a1], [a65536].End(3))
For i = 1 To UBound(Arr)  'AÄæ¸ê®Æ¥Ñ²Ä¤@¦æ¶}©l, ­n§ï¦¨ FOR I=1 TO ??   
    T = Replace(Replace(Arr(i, 1), "¢X", ""), "¥õ¨¤", "/")
    T = Split(Replace(Replace(T, "RR", "1R"), "LR", "2R") & "Âà", "Âà")(0)
    Arr(i, 1) = xD(T) '¦P¦æ¼g¤J, ³o´N¤£¶·¦A¥Î i-4   
Next i
[b1].Resize(UBound(Arr)) = Arr  'µ²ªG¸ê®Æ¸m¤J, ¶·¦P¨B±qB1¤U¤â   
End Sub


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

TOP

¦^´_ 38# wayne0303

°Ñ¦ÒÀÉ:
TEST001.rar (27.31 KB)

TOP

¦^´_ 40# wayne0303

°ÝÃD1: ¥i¯à½d³ò¦³»~
Set xU = xB.Sheets("¤u§@ªí1").[a2:az999]
§ï¦¨
Set xU = xB.Sheets("¤u§@ªí1").CELLS

°ÝÃD2:
¥i¯à¬O§ä¤£¨ì "¥­Ås", "¥kÁ³±Û", "¥ªÁ³±Û" ³o¤T­Ó¤å¦r???
¦Û¦æ¥h½T©w¤å¦r¬O§_¦s¦b, ©Î§¹¥þ¤@¼Ë

TOP

        ÀR«ä¦Û¦b : §g¤l¥ß«í§Ó¡A¤p¤H«í¥ß§Ó¡C
ªð¦^¦Cªí ¤W¤@¥DÃD