[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

效果圖：