从不同工作表里提取数据分类汇总(字典用法)

zhaogang1960

Albert128 发表于 2012-12-14 00:25
垦请赵版具体指导一下

请测试:

1. Sub Macro1()
   
2.     Dim arr, brr(1 To 65530, 1 To 3), i&, j&, m&, d As Object
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     For j = 2 To 3
   
5.         arr = Sheets(j).[a1].CurrentRegion
   
6.         For i = 3 To UBound(arr)
   
7.             If Not d.Exists(arr(i, 11)) Then
   
8.                 m = m + 1
   
9.                 d(arr(i, 11)) = m
   
10.                 brr(m, 1) = arr(i, 11)
    
11.                 brr(m, j) = arr(i, 12)
    
12.             Else
    
13.                 brr(d(arr(i, 11)), j) = brr(d(arr(i, 11)), j) + arr(i, 12)
    
14.             End If
    
15.         Next i
    
16.     Next j
    
17.     Range("B4:D65536").ClearContents
    
18.     [b4].Resize(m, 3) = brr
    
19. End Sub
    

复制代码

zhaogang1960

请看附件
字典法-Revised.rar (19.61 KB, 下载次数: 219)

2012-12-14 02:23 上传

点击文件名下载附件

longwin

不用转置的话，就把数组brr在开始就定义为足够大，把中间的redim 去掉就行了，在你原来的基础上改改

孤独行星双星记

学习下跨表字典法的使用。

LMY123

分表分别分类汇总，再横向合并在总表上
Sub 同薄多表汇总()
    Dim arr, brr(1 To 65530, 1 To 2), i&, j&, m&, d As Object
    Set d = CreateObject("scripting.dictionary")
    For j = 2 To 3
        arr = Sheets(j).[a1].CurrentRegion
        For i = 3 To UBound(arr)
            If Not d.Exists(arr(i, 11)) Then
                m = m + 1
                d(arr(i, 11)) = m
                brr(m, 1) = arr(i, 11)
                brr(m, 2) = arr(i, 12)
            Else
                brr(d(arr(i, 11)), 2) = brr(d(arr(i, 11)), 2) + arr(i, 12)
            End If
        Next i
    Next j
    Range("B4:D65536").ClearContents
    [b4].Resize(m, 2) = brr
End Sub