|
楼主 |
发表于 2020-2-8 00:17
|
显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
按指定标题行排序后分类汇总,排序出问题
按第一行标题行排序后分类汇总出问题,请师傅们帮帮忙!车牌号列计数汇总,实付列求和汇总,按我下面的代码后排序出问题。
Sub Macro1()
Dim arr, d As Object, t, i&, lr&
Application.ScreenUpdating = False
With ActiveSheet.UsedRange
arr = .Range("A2:K" & .Range("d65536").End(xlUp).Row)
End With
With Range("a2").Resize(UBound(arr), UBound(arr, 2))
.Value = arr
.Sort Key1:=Range("B2").Resize(UBound(arr)), Order1:=xlAscending, Key2:=Range("D2").Resize(UBound(arr)), Order2:=xlAscending, Key3:=Range("E2").Resize(UBound(arr)), Order3:=xlAscending
arr = Range("B2:B" & Range("C65536").End(xlUp).Row)
Set d = CreateObject("scripting.dictionary")
For i = 1 To UBound(arr)
If Not d.Exists(arr(i, 1)) Then d(arr(i, 1)) = i + 4
Next
d("") = i + 4
t = d.items
With WorksheetFunction
i = d.Count - 1
Cells(t(i), 1) = "合计"
Cells(t(i), 2) = .CountA(Cells(t(0), 2).Resize(t(i) - t(0)))
Cells(t(i), 8) = .Sum(Cells(t(0), 8).Resize(t(i) - t(0)))
For i = d.Count - 1 To 1 Step -1
Rows(t(i)).Insert
Cells(t(i), 1) = "小计"
Cells(t(i), 2) = .CountA(Cells(t(i - 1), 2).Resize(t(i) - t(i - 1)))
Cells(t(i), 8) = .Sum(Cells(t(i - 1), 8).Resize(t(i) - t(i - 1)))
Next
End With
End With
Application.ScreenUpdating = True
End Sub
|
|