[已解决]用VBA数组按开始结束日期实现分类统计汇总

laoau138 · 发表于 2017-5-29 17:07

用VBA数组按开始结束日期实现分类统计汇总

最佳答案

月排行榜 / 总排行榜

chart888

2017-6-1 10:40

本帖最后由 chart888 于 2017-6-1 11:05 编辑

Private Sub CommandButton1_Click()
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim arr
Dim arr1(1 To 10000, 1 To 20)
Dim arr2(1 To 1, 1 To 20)
Dim D1, D2, sInt
Dim A1, A2, k, k1, x, m, n, i As Integer
Set D1 = CreateObject("Scripting.Dictionary")
Set D2 = CreateObject("Scripting.Dictionary")
With Sheets("Sheet1")
.Range("G1").CurrentRegion.Clear
sInt = Application.InputBox(Prompt:="输入开始日期", Type:=1)
If Len(Trim(sInt)) > 7 Then
A1 = sInt
Else
MsgBox Prompt:="您没有输入有效的日期" & Chr(10) _
& "正确的月份格式为:(例:20150601)", Buttons:=vbOKOnly + vbInformation, _
Title:="错误提示"
Exit Sub
End If
sInt = Application.InputBox(Prompt:="输入结束日期", Type:=1)
If Len(Trim(sInt)) > 7 Then
A2 = sInt
Else
MsgBox Prompt:="您没有输入有效的日期" & Chr(10) _
& "正确的月份格式为:(例:20150601)", Buttons:=vbOKOnly + vbInformation, _
Title:="错误提示"
Exit Sub
End If
k1 = 3
arr = .Range("A2:D" & .Range("A65536").End(xlUp).Row)
For x = 1 To UBound(arr)
If arr(x, 1) >= A1 And arr(x, 1) <= A2 Then
If D1.Exists(arr(x, 3)) Then
n = D1(arr(x, 3))
If D2.Exists(arr(x, 2)) Then
m = D2(arr(x, 2))
arr1(m, n) = arr1(m, n) + arr(x, 4)
GoTo AA
Else
k = k + 1
D2(arr(x, 2)) = k
arr1(k, 1) = arr(x, 2)
arr1(k, n) = arr(x, 4)
GoTo AA
End If
Else
k1 = k1 + 1
D1(arr(x, 3)) = k1
arr2(1, k1) = arr(x, 3)
End If
If D2.Exists(arr(x, 2)) Then
m = D2(arr(x, 2))
arr1(m, n) = arr1(m, n) + arr(x, 4)
Else
k = k + 1
D2(arr(x, 2)) = k
arr1(k, 1) = arr(x, 2)
arr1(k, k1 - 1) = arr(x, 4)
End If
End If
AA:
Next
arr2(1, 1) = "开始—结束"
arr2(1, 2) = "姓名"
arr2(1, 3) = "销售额合计"
.Range("H2").Resize(k, D1.Count + 2) = arr1
.Range("G1").Resize(1, D1.Count + 3) = arr2
.Range("G2") = A1
.Range("G3") = A2
.Cells(D2.Count + 2, 8) = "合计"
For i = 2 To D2.Count + 1
.Cells(i, 9) = WorksheetFunction.Sum(.Range(Cells(i, 10).Address, Cells(i, D1.Count + 9).Address))
Next
.Cells(D2.Count + 2, 9) = WorksheetFunction.Sum(.Range(Cells(2, 9).Address, Cells(D2.Count + 1, 9).Address))
With .Range("G1").CurrentRegion.Borders
.LineStyle = xlContinuous
.Weight = xlThin
End With
With .Range("G1").Resize(D2.Count + 2, D1.Count + 3)
.EntireColumn.AutoFit
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter
.Font.Name = "微软雅黑"
.Font.Size = 11
End With
With .Range("G1").Resize(1, D1.Count + 3)
.Font.FontStyle = "Bold"
.Interior.ColorIndex = 34
End With
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

复制代码

跳转到最佳答案楼层

france723 · 发表于 2017-5-29 17:28

用字典法可以很好解决, 大灰狼老师给过你很多范本, 参考后你可以自己实现. 具体有问题可以提问.

laoau138 · 发表于 2017-5-29 17:31

france723 发表于 2017-5-29 17:28
用字典法可以很好解决, 大灰狼老师给过你很多范本, 参考后你可以自己实现. 具体有问题可以提问.

不懂要用数组方法

laoau138 · 发表于 2017-5-29 17:32

france723 发表于 2017-5-29 17:28
用字典法可以很好解决, 大灰狼老师给过你很多范本, 参考后你可以自己实现. 具体有问题可以提问.

小猫这2条没有做

http://www.excelpx.com/thread-430649-1-1.html

VBA改写数组并且不要用find 可选择统计行数

http://www.excelpx.com/thread-430663-1-1.html

用VBA输入图案不用rept函数还能用什么

laoau138 · 发表于 2017-5-29 19:14

france723 发表于 2017-5-29 17:28
用字典法可以很好解决, 大灰狼老师给过你很多范本, 参考后你可以自己实现. 具体有问题可以提问.

你没有写啊

laoau138 · 发表于 2017-5-29 19:53

france723 发表于 2017-5-29 17:28
用字典法可以很好解决, 大灰狼老师给过你很多范本, 参考后你可以自己实现. 具体有问题可以提问.

不懂了这个

laoau138 · 发表于 2017-5-31 14:03

再顶一次了

chart888 · 发表于 2017-5-31 14:42

没有看懂你的要求
你表达的和你给的模拟结果完全看不懂

laoau138 · 发表于 2017-5-31 15:03

chart888 发表于 2017-5-31 14:42
没有看懂你的要求
你表达的和你给的模拟结果完全看不懂

哪里不懂了

chart888 · 发表于 2017-5-31 16:21

实现了部功能你先看看是不是要这样的
如果是的我再完善后续的

		自动登录	找回密码
密码			注册

[已解决]用VBA数组按开始结束日期实现分类统计汇总

点评

点评

评分

评分

[已解决]用VBA数组按开始结束日期 实现分类统计汇总

点评

点评

评分

评分

[已解决]用VBA数组按开始结束日期实现分类统计汇总