lpk187

回復 5# terrykyo520
試試！

1. Public Sub ex()
   
2. Dim ar()
   
3. arr = Range("a2:C" & Cells(Rows.Count, 1).End(xlUp).Row)
   
4. k = UBound(arr)
   
5. For i = 1 To UBound(arr) - 1
   
6.     For j = i + 1 To UBound(arr)
   
7.         If arr(i, 1) = "" Or arr(j, 1) = "" Then GoTo 10
   
8.         If arr(i, 2) & arr(i, 3) = arr(j, 2) & arr(j, 3) Then
   
9.             arr(j, 1) = ""
   
10.             arr(j, 2) = ""
    
11.             arr(j, 3) = ""
    
12.             k = k - 1
    
13.         End If
    
14. 10:
    
15.     Next
    
16. Next
    
17. 
    
18. ReDim ar(1 To k, 1 To 3)
    
19. k = 1
    
20. For i = 1 To UBound(arr)
    
21.     If arr(i, 1) <> "" Then
    
22.         ar(k, 1) = arr(i, 1)
    
23.         ar(k, 2) = arr(i, 2)
    
24.         ar(k, 3) = arr(i, 3)
    
25.         k = k + 1
    
26.     End If
    
27. Next
    
28. Range("a2:C" & Cells(Rows.Count, 1).End(xlUp).Row).Clear
    
29. [a2].Resize(UBound(ar), 3) = ar
    
30. End Sub

複製代碼

lpk187

回復 12# terrykyo520

Cells(Rows.Count, 1).End(xlUp).Row是A欄的最後一格的列號，Rows.Count為所有的列號，1就是A欄
原來的欄數只有些3欄，所以寫的比較簡單，但是若資料數量很多時就不能如下面表示的寫法，
            arr(j, 1) = ""
            arr(j, 2) = ""
            arr(j, 3) = ""
            ...
            ....
            .......
            .......
            arr(j, X) = ""
這樣寫會累死的
所以必須多一個迴圈

1. Public Sub ex()
   
2. Dim ar()
   
3. arr = Range("A2:AD" & Cells(Rows.Count, 1).End(xlUp).Row)
   
4. K = UBound(arr)
   
5. For I = 1 To UBound(arr) - 1
   
6.     For j = I + 1 To UBound(arr)
   
7.         If arr(I, 1) = "" Or arr(j, 1) = "" Then GoTo 10
   
8.         If arr(I, 13) & arr(I, 17) = arr(j, 13) & arr(j, 17) Then
   
9.             For L = 1 To UBound(arr, 2)
   
10.                 arr(j, L) = ""
    
11.             Next
    
12.             K = K - 1
    
13.         End If
    
14. 10:
    
15.     Next
    
16. Next
    
17. 
    
18. ReDim ar(1 To K, 1 To UBound(arr, 2))
    
19. K = 1
    
20. For I = 1 To UBound(arr)
    
21.     If arr(I, 1) <> "" Then
    
22.         For L = 1 To UBound(arr, 2)
    
23.             ar(K, L) = arr(I, L)
    
24.         Next
    
25.         K = K + 1
    
26.     End If
    
27. Next
    
28. Range("a2:AD" & Cells(Rows.Count, 1).End(xlUp).Row).Clear
    
29. [a2].Resize(UBound(ar), UBound(arr, 2)) = ar
    
30. End Sub

複製代碼