求助跨表非重复想计数

还可以融合表格后（想办法融合），进行透视，或UNI

Sub 问题()
Dim name, adr, arr, brr, dic, j, i, c
Set dic = CreateObject("scripting.dictionary")
name = InputBox("标题", "输入汇总表姓名单元格的坐标(例如A1=姓名，A2=张三)，那么请输入A1")
adr = InputBox("标题", "输入ID列的起始坐标(例如A1=ID，A2=12)，那么请输入A1")
arr = Range(name).CurrentRegion
c = 1
For i = 1 To Sheets. Count
For j = 2 To UBound(arr, 1)
If Sheets(i).name = arr(j, 1) Then
brr = Sheets(i).Range(adr).CurrentRegion
For k = 2 To UBound(brr, 1)
If brr(k, 2) = "是" Then
dic(brr(k, 1)) = ""
End If
Next
Sheets("汇总").Range(name).Offset(c, 1) = dic. Count
dic. RemoveAll
c = c + 1
Exit For
End If
Next
Next
End Sub