Sub Macro1()
Dim arr, brr(1 To 60000, 1 To 2), sh As Worksheet, lr&, i&, m&, d As Object
'建立壹個空的匯總表格,建立這個表格的主要目的是要應用下來的Exists方法,免得壹個壹個檢查太麻煩
Set d = CreateObject("scripting.dictionary")
'對工作簿裏的每壹個表格進行操作
For Each sh In Sheets
'除了匯總表之外
If sh.Name <> "匯總表" Then
'先找到表格B列的最後壹行
lr = sh.[b65536].End(xlUp).Row
'如果最後壹行行號大於3
If lr > 3 Then
'就把B、C兩列從第4行到最後壹行復制到數組arr
arr = sh.Range("b4:c" & lr)
'檢查B、C兩列從第4行到最後壹行的數據
For i = 1 To UBound(arr)
'如果B列的數據不在在匯總表格d裏面
If Not d.Exists(arr(i, 1)) Then
'把B列的數據添加到匯總表格d裏面,給它壹個序號,對應另壹個匯總表brr的編號
m = m + 1
d(arr(i, 1)) = m
'把B、C兩列數據添加到匯總表brr裏面
brr(m, 1) = arr(i, 1)
brr(m, 2) = arr(i, 2)
Else
'如果果B列的數據在匯總表d裏面已經存在,則利用剛建立的序號引用另壹個匯總表brr中與B列數據相同的項,讓C列的數據進行累加
brr(d(arr(i, 1)), 2) = brr(d(arr(i, 1)), 2) + arr(i, 2)
End If
Next
End If
End If
Next
'清除匯總表的數據區域
ActiveSheet.UsedRange.Offset(2).ClearContents
'把匯總的數據貼在A3開始的區域
[a3].Resize(m, 2) = brr
End Sub