单次的去除了
=============================
Sub 统计3()
Dim sh As Worksheet, arr, brr(1 To 10000, 1 To 10), crr(1 To 10000, 1 To 10), i&, j&, k&, temp$, temp2$, n&, d As Object
Set d = CreateObject("scripting.dictionary")
For Each sh In Sheets
If (sh.Name Like "Sheet1") = False Then
arr = sh.[a1].CurrentRegion.Value
For i& = 2 To UBound(arr)
For j& = 1 To UBound(arr, 2)
temp$ = Trim(arr(i, j))
If temp$ <> "" Then
If d.exists(temp$) = False Then
k& = k& + 1
d(temp$) = k&
End If
n& = d(temp$)
brr(n&, 1) = temp$
brr(n&, 2) = brr(n&, 2) + 1
temp2$ = sh.Name & "!" & sh.Cells(i, j).Address(0, 0)
brr(n&, 2 + brr(n&, 2)) = "=HYPERLINK(" & Chr(34) & "#" & temp2$ & Chr(34) & "," & Chr(34) & temp2$ & Chr(34) & ")"
End If
Next j&
Next i&
End If
Next sh
k& = 0
For i& = 1 To d.Count
If brr(i&, 2) > 1 Then
k& = k& + 1
For j& = 1 To 10
crr(k&, j&) = brr(i&, j&)
Next j&
End If
Next i&
Application.ScreenUpdating = False
Sheets("sheet1").Range("A2:J1000").ClearContents
Sheets("sheet1").Range("A2").Resize(k&, 10) = crr
Application.ScreenUpdating = True
End Sub |