|
短信收到,代码稍微修改即可用字典查询
Sub Macro1()
Dim arr, brr(1 To 60000, 1 To 3), d, i%, j&, k%, s&
Set d = CreateObject("scripting.dictionary")
For i = 1 To Sheets.Count
If Sheets(i).Name <> "Sheet1" Then
arr = Sheets(i).UsedRange
For j = 2 To UBound(arr) Step 2
For k = 1 To UBound(arr, 2)
If arr(j, k) <> "" And Not d.exists(arr(j, k)) Then
s = s + 1: d(arr(j, k)) = arr(j + 1, k): brr(s, 1) = arr(j, k): brr(s, 2) = arr(j + 1, k)
End If
If j = 2 And k = 1 Then brr(s, 3) = arr(1, 1)
Next
Next
End If
Next
Range("a1").Resize(s, 3) = brr
End Sub |
|