[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

效果图：