samwang

¦^´_ 1# jackson7015

½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ

Sub test()
Dim Arr, Brr(), xD, xD1, T$, AR%, BR%, DR%
Set xD = CreateObject("Scripting.Dictionary")
Set xD1 = CreateObject("Scripting.Dictionary")
R = Columns("C:E").Find("*", SearchDirection:=xlPrevious).Row
Arr = Range("C1:E" & R)
For j = 1 To 3: For i = 2 To UBound(Arr)
T = Arr(i, j): xD(T & "_" & j) = 1: xD1(T) = 1
Next i: Next j
Arr = Range([a1], [a65536].End(3))
ReDim Brr(1 To UBound(Arr), 1 To 3)
For i = 2 To UBound(Arr)
    T = Arr(i, 1): N = xD1(T)
    If N <> 1 Then DR = DR + 1: Brr(DR, 1) = T: GoTo 99
    For j = 1 To 2
        If xD.Exists(T & "_" & j) Then
            If j = 1 Then
                If Not xD.Exists(T & "_3") Then
                    AR = AR + 1: Brr(AR, 2) = T
                End If
            Else
                BR = BR + 1: Brr(BR, 3) = T
            End If
        End If
    Next
99: Next
Range("g2").Resize(UBound(Brr), 3) = Brr
End Sub