|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
Sub Macro1()
Dim i%, arr(), k, brr(), m%, n%
Dim d As Object
Set d = CreateObject("Scripting.dictionary") ‘定义字典
arr = Sheet2.Range("a1").CurrentRegion ’设置数组范围
‘-------下面这段是将数组里面的月份改为季度,方面后面按季度加总
arr(2, 1) = "一季度": arr(3, 1) = "一季度": arr(4, 1) = "一季度"
arr(5, 1) = "二季度": arr(6, 1) = "二季度": arr(7, 1) = "二季度"
arr(8, 1) = "三季度": arr(9, 1) = "三季度": arr(10, 1) = "三季度"
arr(11, 1) = "四季度": arr(12, 1) = "四季度": arr(13, 1) = "四季度"
m = UBound(arr): n = UBound(arr, 2) ’m取得数组的下标,n取得数组的右标
ReDim Preserve brr(1 To m, 1 To n) ‘重新定义数组brr,方便将结果存入数组
For i = 1 To m '遍历数据有效行
k = d(arr(i, 1)) '用字典查询关键词(数据第1列)是否已经存入字典
If k = "" Then '如果结果为空白,则该关键字尚未加入字典
s = s + 1: d(arr(i, 1)) = s: k = s 新的行位置指针值s+1递增(即新添一个单词)、接着把该关键词加入字典、最后对k变量赋值=s指针
brr(s, 1) = arr(i, 1) 把这个新单词的第1列内容写入结果数组
End If
For j = 2 To n '接下来,遍历第2列只到最后,把该关键词对应的统计数据加总到结果数组brr相应的行、列位置。
brr(k, j) = brr(k, j) + arr(i, j) '这里不管开始查询时字典内是否有这个关键词,最后都是以t变量为记录时行位置的指针。
Next
Next
Sheet2.Range("i2").Resize(s, n) = brr '输出结果到工作表指定区域
End Sub |
|