­ã´£³¡ªL

Ãþ§O        §PÂ_±ø¥ó
A        0
B        0
C        0
D        2
F        2
G        2
H        0
I        0
J        2
K        2
L        2


³o­n¦p¦ó¤ñ¹ï??

==============

­ã´£³¡ªL

¦^´_ 8# peter631114


Sub TEST()
Dim Arr, Brr, i&, j&, N&
Arr = Range([B1], Cells(Rows.Count, 1).End(xlUp))
ReDim Brr(1 To 20000, 1 To 3)
For i = 2 To UBound(Arr)
    For j = 2 To UBound(Arr)
        If i <> j And Arr(i, 2) = Arr(j, 2) Then
           N = N + 1
           Brr(N, 1) = Arr(i, 1)
           Brr(N, 3) = Arr(j, 1)
        End If
    Next j
Next i
If N = 0 Then Exit Sub
[F2:H2].Resize(N) = Brr
End Sub

Xl0000362.rar (12.25 KB)

¤U¸ü¦¸¼Æ: 9

2019-6-17 20:10

======================