Kubi

¦^´_ 1# Changbanana
¥Î¤F¤@­ÓDictionaryª«¥ó¡A¬Ý¬Ý°õ¦æ³t«×¬O§_¯à´£¤É¡H

1. Sub test()
   
2.     Dim d As Object
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     Dim arr, brr()
   
5.     With Sheets("¤u§@ªí2")
   
6.         er = .[A65536].End(3).Row
   
7.         arr = .Range("A2:B" & er)
   
8.     End With
   
9.     For i = 1 To UBound(arr)
   
10.         If d.exists(arr(i, 2)) Then
    
11.             d(arr(i, 2)) = "¡ô"
    
12.         Else
    
13.             d(arr(i, 2)) = "'" & arr(i, 1)
    
14.         End If
    
15.     Next i
    
16.     With Sheets("¤u§@ªí1")
    
17.         .Range("G2:G65536").ClearContents
    
18.         er = .[A65536].End(3).Row
    
19.         arr = .Range("A2:B" & er)
    
20.     End With
    
21.     For i = 1 To UBound(arr)
    
22.         If d.exists(arr(i, 1)) Then
    
23.             If d(arr(i, 1)) = "¡ô" Then
    
24.                 arr(i, 2) = ""
    
25.                 n = n + 1
    
26.                 ReDim Preserve brr(1 To n)
    
27.                 brr(n) = arr(i, 1)
    
28.             Else
    
29.                 arr(i, 2) = d(arr(i, 1))
    
30.             End If
    
31.         Else
    
32.             arr(i, 2) = ""
    
33.         End If
    
34.     Next i
    
35.     Sheets("¤u§@ªí1").[A2].Resize(UBound(arr), 2) = arr
    
36.     Sheets("¤u§@ªí1").[G2].Resize(UBound(brr), 1) = Application.Transpose(brr)
    
37.     Set d = Nothing
    
38.     arr = ""
    
39.     Erase brr
    
40. End Sub

½Æ»s¥N½X

Kubi

¦^´_ 5# Changbanana

³o "¡ô" ¨Ã¨S¦³¯S§Oªº·N¸q¡A¥u¬OÀH¤â®³¨Ó°µ¬°©³¤U§PÂ_¦¡ÅçÃҥΦӤw¡A¦]¦¹§A¤]¥i¥H¥Î¨ä¥L²Å¸¹¨Ó¥N´À³á¡C