Sub 数据匹配()
Dim arr, brr
Set d = CreateObject("scripting.dictionary") '建立一个字典对象d
Set d1 = CreateObject("scripting.dictionary") '建立一个字典对象d1
For Each sh In ThisWorkbook.Worksheets '在当前的工作簿中查找工作表名不为"合并"的工作表
If sh.Name <> "合并" Then '如果找到工作表名不为"合并"的工作表则做下面的工作：比较合并
m = 0: n = 0
arr = sh.[a1].CurrentRegion '把当前工作表的内容赋给数组arr
For i = 2 To UBound(arr) '把当前工作表的第2列内容作为字典d标志，并给他赋值i，估计第2列里的内容是标志性的
d(arr(i, 2)) = i
Next i
For j = 2 To UBound(arr, 2) '把当前工作表的第1行内容作为字典d1标志，并给他赋值j，估计第1行是标题行
d1(arr(1, j)) = j
Next j
f = Dir(ThisWorkbook.Path & "\" & sh.Name & ".xls*") '在当前工作簿目录下查找以当前工作表名称命名的工作簿
If f = "" Then GoTo 100 '如果在当前工作簿目录下没有找到"合并"命名的工作簿，那就跳出
Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & f) '找到的话，就打开工作簿
brr = wb.Worksheets(1).[a1].CurrentRegion '把打开工作簿中工作表1的内容赋给数组brr
For i = 2 To UBound(brr) '把根据字典d，d1中存储的标志信息和值，进行比对查找
m = d(brr(i, 1))
Debug.Print i; m
For j = 2 To UBound(brr, 2)
n = d1(brr(1, j))
Debug.Print j; n
If m <> "" And n <> "" Then '如果在字典d，d1中找到存储的标志信息，则更新相应的arr中存储的值
arr(m, n) = brr(i, j)
Debug.Print "zd:"; arr(m, n)
End If
Next j
Next i
wb.Close False
sh.[a1].CurrentRegion = arr? '把比对更新后arr中存储的值重新赋值给当前工作表，完成比对更新！
End If
Next sh
100:
'MsgBox "pk"
End Sub
比如有这样的2个工作簿：
在sdd1.xls中就可以运行宏来更新各个学生的各科目成绩！并且在SS合并中学号和学科名称可以任意排列：如下：