GBKEE

¦^´_ 1# ivan731129
½Ðªþ½d¨ÒÀÉ®× ¤W¨Ó

GBKEE

¦^´_ 3# ivan731129
03ª©

1. Sub Ex()
   
2.     Dim D(1 To 2) As Object, R, SH As Worksheet, T As String, I As Integer, AR(), A
   
3.     Dim ShCount As Integer
   
4.     Set D(1) = CreateObject("SCRIPTING.DICTIONARY")
   
5.     Set D(2) = CreateObject("SCRIPTING.DICTIONARY")
   
6.     With Sheets("¶°¦XÀÉ")
   
7.         .Cells.Clear
   
8.         For Each SH In Sheets
   
9.             If SH.Name = "¶°¦XÀÉ" Then Exit For
   
10.             ShCount = ShCount + 1
    
11.             For Each R In SH.Range("A1").CurrentRegion.Rows
    
12.                 T = R.Cells(1) & "," & Join(Application.Transpose(Application.Transpose(R.Cells(1, 1).Resize(1, 8))), ",")
    
13.                 If D(1).Exists((T)) = False Then
    
14.                     D(1)(T) = Array(False, 1)
    
15.                     D(2)(T) = Array(Join(Application.Transpose(Application.Transpose(R)), ","))
    
16.                 Else
    
17.                      D(1)(T) = Array(True, D(1)(T)(1) + 1)
    
18.                      If R.Row <> 1 Then
    
19.                         AR = D(2)(T)
    
20.                         ReDim Preserve AR(UBound(AR) + 1)
    
21.                         AR(UBound(AR)) = Join(Application.Transpose(Application.Transpose(R)), ",")
    
22.                         D(2)(T) = AR
    
23.                     End If
    
24.                 End If
    
25.             Next
    
26.         Next
    
27.         For Each R In D(1).KEYS
    
28.             If D(1)(R)(0) = True And D(1)(R)(1) = ShCount Then  'D(1)(R)(1) = ShCount ¨C­Ó¸ê®Æ®w³£¥X²{
    
29.                 For Each A In D(2)(R)
    
30.                     I = I + 1
    
31.                     .Cells(I, 1).Resize(1, UBound(Split(A, ",")) + 1) = Split(A, ",")
    
32.                 Next
    
33.             End If
    
34.         Next
    
35.     End With
    
36. End Sub

½Æ»s¥N½X