[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

效果图：