Kubi

回復 1# Changbanana
用了一個Dictionary物件，看看執行速度是否能提升？

1. Sub test()
   
2.     Dim d As Object
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     Dim arr, brr()
   
5.     With Sheets("工作表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("工作表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("工作表1").[A2].Resize(UBound(arr), 2) = arr
    
36.     Sheets("工作表1").[G2].Resize(UBound(brr), 1) = Application.Transpose(brr)
    
37.     Set d = Nothing
    
38.     arr = ""
    
39.     Erase brr
    
40. End Sub

複製代碼

Kubi

回復 5# Changbanana

這 "↑" 並沒有特別的意義，只是隨手拿來做為底下判斷式驗證用而已，因此你也可以用其他符號來代替喔。