[VBA]去重彙總

問題描述：彙總多個工做表的指定字段到sheet1裏面，並去除重複的字段內容。

Sub 去重彙總（）

Dim sht As Worksheet, j As Integer, x As Integer

Set d = CreateObject("scripting.dictionary")

For Each sht In Worksheets

    If sht.Name <> ActiveSheet.Name Then

        j = sht.Range("a65536").End(xlUp).Row

        arr = sht.Range("a3:a" & j)

            For x = 1 To UBound(arr)

            d(arr(x, 1)) = ""

            Next

    End If

Next

k = d.keys

ActiveSheet.Range("a2").Resize(d.Count, 1) = Application.Transpose(k)

End Sub

效果圖：