|
修改一、将以《会员缴费表》A1查询汇总修改为H1查询汇总。
修改二、将保存到《Sheet1》的内容E到A之间的空单元格合并。
修改三、在最后一行增加总计。
Sub 推荐人汇总()
arr = [a1].CurrentRegion
ReDim brr(1 To UBound(arr), 1 To 9)
Set d = CreateObject("scripting.dictionary")
For i = 2 To UBound(arr) - 0
x = arr(i, 1) & "," & arr(i, 2) & "," & arr(i, 3) & "," & arr(i, 4) & "," & arr(i, 5) & "," & arr(i, 6) & "," & arr(i, 7) & "," & arr(i, 8) & "," & arr(i, 9)
If Not d.exists(x) Then
n = n + 1: d(x) = n
brr(n, 1) = arr(i, 1): brr(n, 2) = arr(i, 2)
brr(n, 3) = arr(i, 3): brr(n, 4) = arr(i, 4)
brr(n, 5) = arr(i, 5): brr(n, 6) = arr(i, 6)
brr(n, 7) = arr(i, 7): brr(n, 8) = arr(i, 8)
brr(n, 9) = arr(i, 9)
End If
p = d(x)
brr(p, 5) = brr(p, 5) + arr(i, 5)
Next
With Sheet1
.Cells.Clear
.[a1].Resize(1, 9) = Array("推荐人", "会员形式", "姓名", "性别", "金额", "联系方式", "备注", "编号", "交款日期")
.[a2].Resize(n, 9) = brr
.[a2].Resize(n, 9).Sort key1:=.[a2], key2:=.[b2], key3:=.[c2]
arr = .[a2].Resize(n + 1, 9)
ReDim brr(1 To UBound(arr) + 100, 1 To 9)
n = 0
For i = 1 To UBound(arr) - 1
n = n + 1
For J = 1 To 9: brr(n, J) = arr(i, J): Next
s1 = s1 + arr(i, 5)
If arr(i, 1) <> arr(i + 1, 1) Then
n = n + 1
brr(n, 1) = arr(i, 1) & "总计"
brr(n, 5) = s1
s1 = 0
End If
Next
.[a2].Resize(n, 9) = brr
.Activate
End With
End Sub
改写一下代码。 - Sub 推荐人汇总()
- With Sheets("会员缴费表")
- r = .[a65536].End(3).Row
- org = .Range("a1:i" & r) '原数组
- Application.EnableEvents = False
- .[a2].Resize(r - 1, 9).Sort key1:=.[h2], key2:=.[a2], key3:=.[b2] '按H列排序
- arr = .Range("a1:i" & r + 1) '读入数组(加一行,避免最后一行比较时出错)
- .Range("a1:i" & r) = org '恢复原序
- Application.EnableEvents = True
- ReDim brr(1 To UBound(arr) + 100, 1 To 9)
- Set d = CreateObject("scripting.dictionary")
- For i = 2 To r
- x = Join(Application.Index(arr, i), ",") '每行各列相连为key
- If Not d.exists(x) Then
- n = n + 1: d(x) = n
- For j = 1 To 9
- brr(n, j) = arr(i, j)
- Next
- Else
- p = d(x)
- brr(p, 5) = brr(p, 5) + arr(i, 5)
- End If
- s1 = s1 + arr(i, 5)
- If arr(i, 8) <> arr(i + 1, 8) Then
- n = n + 1
- s = s + s1
- brr(n, 1) = arr(i, 8) & "总计"
- brr(n, 5) = s1
- s1 = 0
- End If
- Next
- n = n + 1
- brr(n, 1) = "总计": brr(n, 5) = s
- End With
-
- With Sheet1
- .Cells.Clear
- .[a1].Resize(1, 9) = Array("推荐人", "会员形式", "姓名", "性别", "金额", "联系方式", "备注", "编号", "交款日期")
- .[a2].Resize(n, 9) = brr
- For i = 1 To n
- If brr(i, 1) Like "*总计" Then .Cells(i + 1, 1).Resize(1, 4).Merge
- Next
- .Activate
- End With
- End Sub
复制代码
|
|