­ã´£³¡ªL

Sub ¥¨¶°1()
Dim Arr, Brr(1 To 1000, 1), xD, S As Worksheet, SN$, i&, T$, N&
Set xD = CreateObject("Scripting.Dictionary")
For Each S In Sheets
    Arr = S.[a1].CurrentRegion: SN = S.Name
    If Not SN Like "*#¤é" Then GoTo x01
    For i = 2 To UBound(Arr)
        T = Arr(i, 1):  xD(T) = xD(T) + 1
        If xD(T) = 2 Then N = N + 1: Brr(N, 0) = T: Brr(N, 1) = SN: xD(T) = -9 ^ 9
    Next i
    xD.RemoveAll
x01: Next
With Sheets("Á`ªí")
    .[a1].CurrentRegion.Offset(1).ClearContents
    If N > 0 Then .[a2].Resize(N, 2) = Brr
End With
End Sub

­ã´£³¡ªL

¦^´_ 6# av8d


-9^9=-387420489   -9ªº9¦¸¤è,
·í¹J¨ì­«ÂвĤG¦¸®É, ¨Ï¦r¨å±a­È -9^9,
°¸«á¦A¹J¨ì, ¦A«ç»ò¥[+1, ¤j¬ù¤£·|ÅÜ¥¿¼Æ~~

­ã´£³¡ªL

¦^´_ 9# av8d

resize ¦@¯à¥Î¦b rangeª«¥ó, array¤¤¥u¯à¶]°j°é³v¤@¼g¤J:

Sub ¥¨¶°3()
Dim Arr, Brr(1 To 1000, 1 To 4), xD, S As Worksheet, SN$, i&, j%, T$, N&
Set xD = CreateObject("Scripting.Dictionary")
For Each S In Sheets
    Arr = S.[a1].CurrentRegion: SN = S.Name
    If Not SN Like "*#¤é" Then GoTo x01
    For i = 2 To UBound(Arr)
        T = Arr(i, 2):  xD(T) = xD(T) + 1
        If xD(T) = 2 Then
           N = N + 1: xD(T) = -9 ^ 9
           For j = 1 To 3: Brr(N, j) = Arr(i, j): Next
           Brr(N, 4) = SN
        End If
    Next i
    xD.RemoveAll
x01: Next
With Sheets("Á`ªí")
    .[a1].CurrentRegion.Offset(1).ClearContents
    If N > 0 Then .[a2].Resize(N, 4) = Brr
End With
End Sub

­ã´£³¡ªL

¦^´_ 11# av8d


­Y­n³s±µ¤å¦r, ³Ì¦n¾i¦¨²ßºD¥["¤À¹j²Å¸¹"
¨Ò:
A  AA...."A" & "AA" = "AAA"
AA  A..."AA" & "A" = "AAA"
¨âªÌµLªk¤À¿ë, µø¬°¬Û¦P,
§ï¦¨:
A  AA...."A" & "|" & "AA" = "A|AA"
AA  A..."AA" & "|" & "A" = "AA|A"
§Y¥i²M·¡¤À¿ë®t²§, ÁöµM¹J¨ì¾÷·|¤£¦h, ¦ýÁÙ¬OÂÔ·V~~

­ã´£³¡ªL

«Øij¥Î16¼Ósamwang ¤jªº¤èªk...¥Î¨â¦¸°j°é~~

¥H¤U¨âºØ¥N½X¶È¨Ñ°Ñ¦Ò, Ãø¥H²z¸Ñ, ¤£·Q¦h°µ¸ÑÄÀ¤F!
Sub TEST_A1()
Dim Arr, Brr, Crr, xD, S As Worksheet, SN$, T$, U&, i&, j%, k&, N&, P%
Set xD = CreateObject("Scripting.Dictionary")
ReDim Brr(1 To 30000, 1 To 4): Crr = Brr
For Each S In Sheets
    Arr = S.[a1].CurrentRegion: SN = S.Name
    If Not SN Like "*#¤é" Then GoTo x01
    For i = 2 To UBound(Arr)
        T = Arr(i, 1) & "|" & Arr(i, 2) & "|" & Arr(i, 3)
        k = k + 1: Crr(k, 4) = SN: U = xD(T): P = 0
        If U > 0 Then N = N + 1: P = 1
        For j = 1 To 4
            If j < 4 Then Crr(k, j) = Arr(i, j)
            If U > 0 Then Brr(N, j) = Crr(U, j): xD(T) = -1
            If U < 0 Or P = 1 Then Brr(N + 1, j) = Crr(k, j)
        Next j
        If xD(T) = 0 Then xD(T) = k Else N = N + 1
i01: Next i
x01: Next
With Sheets("Á`ªí")
    .[a1].CurrentRegion.Offset(1).ClearContents
    If N > 0 Then .[a2].Resize(N, 4) = Brr
End With
End Sub

'============================
Sub TEST_A2()
Dim Arr, Brr, Crr, xD, S As Worksheet, SN$, T$, i&, j%, k&, N&
Set xD = CreateObject("Scripting.Dictionary")
ReDim Brr(1 To 30000, 1 To 4): Crr = Brr
For Each S In Sheets
    Arr = S.[a1].CurrentRegion: SN = S.Name
    If Not SN Like "*#¤é" Then GoTo x01
    For i = 2 To UBound(Arr)
        k = k + 1: Crr(k, 4) = SN: T = "": U = 0
        For j = 1 To 3
            T = T & "|" & Arr(i, j)
            Crr(k, j) = Arr(i, j)
        Next j
        If xD(T) = 0 Then xD(T) = k: GoTo i01
        If xD(T) > 0 Then U = xD(T): N = N + 1: xD(T) = -1
        For j = 1 To 4
            If U > 0 Then Brr(N, j) = Crr(U, j)
            Brr(N + 1, j) = Crr(k, j)
        Next
        N = N + 1
i01: Next i
x01: Next
With Sheets("Á`ªí")
    .[a1].CurrentRegion.Offset(1).ClearContents
    If N > 0 Then .[a2].Resize(N, 4) = Brr
End With
End Sub


'======================================

­ã´£³¡ªL

¦^´_ 19# av8d

¨â­Ó°j°é, ²Ä¤@¦¸¼g¤J¦r¨å, ²Ä¤G¦¸Åª¨ú¦r¨å, ¤]¥i°Ñ¦Ò¦p¤U:
Sub TEST_A3()
Dim Arr, Brr(1 To 3000, 1 To 5), Crr, xD, T$, i&, j%, k&, N&, x%
Set xD = CreateObject("Scripting.Dictionary")
For x = 2 To Sheets.Count
    Arr = Sheets(x).[a1].CurrentRegion
    For i = 2 To UBound(Arr)
        T = Arr(i, 1) & "|" & Arr(i, 2) & "|" & Arr(i, 3) '³s±µ¦r¦ê
        xD(T) = xD(T) + 1 '¨Ï¥Î¦r¨å²Ö­p¥X²{¦¸¼Æ
        k = k + 1:  Brr(k, 4) = Sheets(x).Name: Brr(k, 5) = T '¼È®É±N¦U¤u§@ªí¤º®e(§t¤u§@ªí¦WºÙ¤ÎT³s±µ¤å¦r)©ñ¤JBrr
        For j = 1 To 3: Brr(k, j) = Arr(i, j): Next
    Next i
Next
For i = 1 To k '¥HBrr¶]°j°é(¦¹®É¤£¶·¦A³v¤@Ū¨ú¤u§@ªí, ¦P®É´î¤Ö¤å¦r³s±µ°Ê§@, ¥[§Ö³t«×)
    If xD(Brr(i, 5)) > 1 Then N = N + 1 Else GoTo i01
    For j = 1 To 4: Brr(N, j) = Brr(i, j): Next '­«ÂЪº¥Ñ¤W¦Ó¤U¦A¦¸¼g¤JBrr
i01: Next i
With Sheets("Á`ªí")
    .[a1].CurrentRegion.Offset(1).ClearContents
    If N > 0 Then .[a2].Resize(N, 4) = Brr
End With
End Sub