|
- Sub 按钮2_Click()
- With Application
- .ScreenUpdating = False
- .DisplayAlerts = False
- End With
- Dim arr, dic As Object, x, i, m, ii
- arr = Range("a4:Q" & [a65536].End(xlUp).Row)
- Set dic = CreateObject("scripting.dictionary")
- For x = 1 To UBound(arr)
- dic(arr(x, 14)) = arr(x, 14)
- Next
- For m = 1 To dic.Count
- ii = 1
- ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
- For x = 1 To UBound(arr)
- If dic(arr(m, 14)) = Cells(x + 3, 14) Then
- For i = 1 To UBound(arr, 2)
- brr(ii, i) = brr(ii, i) & arr(x, i)
- Next
- ii = ii + 1
- End If
- Next
- Sheets(dic(arr(m, 14))).[a65536].End(xlUp).Offset(1, 0).Resize(UBound(brr), UBound(arr, 2)) = brr
- Erase brr
- Next
- [a4:Q100000].Clear
- With Application
- .ScreenUpdating = True
- .DisplayAlerts = True
- End With
- End Sub
复制代码 |
|