Sub 比對()
Dim Ri&, Rn&, i&, j&, n&, Arr, Brr
Ri = Cells(Rows.Count, 1).End(3).Row
Arr = [A2].Resize(Ri - 1, 2)
Rn = Ri * (Ri - 1)
If Rn >= Rows.Count Then Rn = Rows.Count - 1
Brr = [K2].Resize(Rn, 3): n = 1
For i = 1 To Ri - 1: For j = 1 To Ri - 1
If i <> j Then
If Arr(i, 2) = Arr(j, 2) Then
Brr(n, 1) = Arr(i, 1)
Brr(n, 3) = Arr(j, 1)
n = n + 1
Else: Exit For: End If
End If
Next: Next
[K2].Resize(Rn, 3) = Brr
End Sub
發表於 2019-6-14 01:39
| 
