Hsieh

回復 11# loyyee
並非資料筆數問題
是如果沒有和條件的資料就會造成Resize出錯

1. Sub Ex()
   
2. Dim Ay(), Ay1()
   
3. Set d = CreateObject("Scripting.dictionary")
   
4. Set d1 = CreateObject("Scripting.dictionary")
   
5. [E6].CurrentRegion.Offset(1, 0) = ""
   
6. [I1].CurrentRegion.Offset(1, 0) = ""
   
7. 
   
8. ar1 = [A1].CurrentRegion.Columns(1).Value
   
9. ar2 = [A1].CurrentRegion.Columns(2).Value
   
10. ar = Array(ar1, ar2)
    
11. For i = 0 To 1
    
12. For Each a In ar(i)
    
13.    Select Case i
    
14.    Case 0
    
15.    If a <> "" Then d(a) = d(a) + 1
    
16.    Case 1
    
17.    If a <> "" Then d1(a) = d1(a) + 1
    
18.    End Select
    
19. Next
    
20. Next
    
21. dic = Array(d, d1)
    
22. For i = 0 To 1
    
23. For Each ky In dic(i).keys
    
24. p = IIf(i = 0, 1, 0)
    
25.    If dic(p).exists(ky) = False Then
    
26.    ReDim Preserve Ay(s)
    
27.    Ay(s) = ky
    
28.    s = s + 1
    
29.    End If
    
30.    If dic(i)(ky) > 1 Then
    
31.    ReDim Preserve Ay1(k)
    
32.    Ay1(k) = ky
    
33.    k = k + 1
    
34.    End If
    
35. Next
    
36. If s > 0 Then Cells(2, 9 + i).Resize(s, 1) = Application.Transpose(Ay): s = 0: Erase Ay
    
37. If k > 0 Then Cells(7, 5 + i).Resize(k, 1) = Application.Transpose(Ay1): k = 0: Erase Ay1
    
38. Next
    
39. End Sub

複製代碼