|
Sub 按钮1_Click()
Dim d As New Dictionary, brr(), frr()
On Error Resume Next
[a6:g60000].Clear
arr = Sheet1.Range("a1").CurrentRegion
For i = 2 To UBound(arr)
d(arr(i, 2)) = Array(arr(i, 1), arr(i, 2), arr(i, 3), arr(i, 4), arr(i, 5), arr(i, 6), arr(i, 7))
Next i
t = d.Items
t = WorksheetFunction.Transpose(WorksheetFunction.Transpose(t))
ReDim brr(1 To UBound(t))
For j = 1 To UBound(t)
brr(j) = Join(Array(t(j, 1), t(j, 2), t(j, 3), t(j, 4), t(j, 5), t(j, 6), t(j, 7)))
Next j
crr = Filter(brr, [d2])
ReDim frr(1 To UBound(crr) + 1)
For x = 0 To UBound(crr)
frr(x + 1) = Split(crr(x))
Next x
[a6].Resize(UBound(frr), 7) = WorksheetFunction.Transpose(WorksheetFunction.Transpose(frr))
Sheet1.Range("d5:d5").NumberFormatLocal = "@"
If Err.Number <> O Then MsgBox "未查找到记录”"
End Sub
|
|