SHEET合并

dana0630

想要合并全部的SHEET，合并后相同的内容合并到同一例

gwjkkkkk

Option Explicit
Sub TEST6()
    Dim ar, br, i&, j&, k&, r&, n&, dic As Object, iPosCol&, iColSize&
   
    Application.ScreenUpdating = False
    Set dic = CreateObject("Scripting.Dictionary")
   
    n = Worksheets.Count
    ReDim ar(1 To n)
    For i = 1 To n
        ar(i) = Worksheets(i).UsedRange
    Next i
   
    ReDim br(1 To 10 ^ 4, 1 To 10 ^ 3)
    r = 1
    With Workbooks.Add
        With Sheets(1)
            For j = 1 To UBound(ar)
                For k = 1 To UBound(ar(j), 2)
                    If Len(ar(j)(1, k)) Then
                        If Not dic.exists(ar(j)(1, k)) Then
                            iColSize = iColSize + 1
                            br(1, iColSize) = ar(j)(1, k)
                            dic(ar(j)(1, k)) = iColSize
                        End If
                    End If
                Next k
                For i = 2 To UBound(ar(j))
                    r = r + 1
                    For k = 1 To UBound(ar(j), 2)
                        If dic.exists(ar(j)(1, k)) Then
                            iPosCol = dic(ar(j)(1, k))
                            br(r, iPosCol) = ar(j)(i, k)
                        End If
                    Next k
                Next i
            Next j
            .[A1].Resize(r, iColSize) = br
        End With
    End With
   
    Set dic = Nothing
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

请参考附件。。。