samwang

¦^´_ 1# av8d

½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ
Sub test()
Dim Arr, xD, Brr(1 To 1000, 1 To 2), i&, n%, sh%
Set xD = CreateObject("Scripting.Dictionary")
For sh = 2 To Sheets.Count
    With Sheets(sh)
        Arr = .[a1].CurrentRegion
        For i = 2 To UBound(Arr)
            If xD.Exists(Arr(i, 1)) Then
                If Not xD.Exists(Arr(i, 1) & "|" & Sheets(sh).Name) Then
                    n = n + 1: Brr(n, 1) = Arr(i, 1)
                    Brr(n, 2) = Sheets(sh).Name
                End If
                xD(Arr(i, 1) & "|" & Sheets(sh).Name) = ""
            Else
                xD(Arr(i, 1)) = ""
            End If
        Next
    End With
    xD.RemoveAll
Next
If n > 0 Then
    With Sheets("Á`ªí")
        .[a1].CurrentRegion.Offset(1) = ""
        .Range("a2").Resize(n, 2) = Brr
    End With
End If
End Sub

samwang

¦^´_ 3# av8d


¼g±oµù¸Ñ«Ü²M·¡«Ü¦n¡A³£¥¿½T¡A¤¬¬Û¾Ç²ß§V¤O¦¨ªø¡A·PÁÂ

samwang

¦^´_ 15# av8d
½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ
Sub test()
Dim Arr, xD, Brr(1 To 1000, 1 To 4), i&, n%, sh%, j%, T$
Set xD = CreateObject("Scripting.Dictionary")
For sh = 2 To Sheets.Count
    With Sheets(sh)
        Arr = .[a1].CurrentRegion
        For i = 2 To UBound(Arr)
            T = Arr(i, 1) & "|" & Arr(i, 2) & "|" & Arr(i, 3): xD(T) = xD(T) + 1
        Next
    End With
Next
For sh = 2 To Sheets.Count
    With Sheets(sh)
        Arr = .[a1].CurrentRegion
        For i = 2 To UBound(Arr)
            T = Arr(i, 1) & "|" & Arr(i, 2) & "|" & Arr(i, 3)
            If xD(T) > 1 Then
                n = n + 1: For j = 1 To 3: Brr(n, j) = Arr(i, j): Next
                Brr(n, 4) = Sheets(sh).Name
            End If
        Next
    End With
Next
If n > 0 Then
    With Sheets("Á`ªí")
        .[a1].CurrentRegion.Offset(1) = ""
        .Range("a2").Resize(n, 4) = Brr
    End With
End If
End Sub