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

Albert128

本人自从接触字典后,就挺感兴趣,现在按字典做法,从不同工作表里,取数据分类汇总,至相应的位置,以下代码不知哪里出现了问题，请各位老师指正,.谢谢!

1. Sub WholesalesBaraar()
   
2.     Dim d As Object, Brr(), i, t, sh, cl, Myr&, cz
   
3.     Application.ScreenUpdating = False
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     Sheet1.Range("b4:d10").Select
   
6.     Selection.ClearContents
   
7.         For Each sh In Sheets(Array(Sheet3.Name, Sheet4.Name))
   
8.             Myr = sh.[a3].End(xlDown).Row
   
9.             Set cz = Sheet1.Range("b3:d3").Find(sh.Name, , , 1)
   
10.             If Not cz Is Nothing Then cl = cz.Column - 1
    
11.             Arr = sh.Range("a3:l" & Myr).Value
    
12.                 For i = 1 To UBound(Arr)
    
13.                     t = d(Arr(i, 11))
    
14.                     If t = "" Then
    
15.                         m = m + 1
    
16.                         d(Arr(i, 11)) = m
    
17.                         ReDim Brr(m, 1 To 3)
    
18.                         Brr(m, 1) = Arr(i, 11)
    
19.                         Brr(m, cl) = Brr(m, cl) + Arr(i, 12)
    
20.                     Else
    
21.                         Brr(t, cl) = Brr(t, cl) + Arr(i, 12)
    
22.                     End If
    
23.                 Next
    
24.             Next
    
25.             
    
26.         Sheet1.Range("b4").Resize(m, cl) = Brr
    
27.         Set d = Nothing
    
28.     Application.ScreenUpdating = True
    
29. End Sub

复制代码

纯蓝

＂以下代码不知哪里出现了问题＂
是语法错误？报错了，哪一句报错？报什么错？
还是逻辑错误，即你想要的结果，程序执行后没有达成想要的结果？
你想要什么结果？
看起来　　累　　．．．

longwin

最主要的错误原因在这里（数组redim），但改动不能只改这里：
ReDim Brr(m, 1 To 3)

附件为改正后的 字典法.zip (21.04 KB, 下载次数: 159)

2012-12-13 23:40 上传

点击文件名下载附件

Albert128

longwin 发表于 2012-12-13 23:42
最主要的错误原因在这里（数组redim），但改动不能只改这里：
ReDim Brr(m, 1 To 3)

非常感谢！结果正确
ReDim Preserve Brr(1 To 3, 1 To m),这个不是二维数组吗?怎么还要用到函数(Transpose)

DataBus

Albert128 发表于 2012-12-14 00:03
非常感谢！结果正确
ReDim Preserve Brr(1 To 3, 1 To m),这个不是二维数组吗?怎么还要用到函数(Transpo ...

worksheetfunction transpose 可以帮助2维数组转置，但数组不能太大，你也可以自己写转置程序。

zhaogang1960

Albert128 发表于 2012-12-14 00:03
非常感谢！结果正确
ReDim Preserve Brr(1 To 3, 1 To m),这个不是二维数组吗?怎么还要用到函数(Transpo ...

transpose 限制很多，且速度很慢，应尽量避免使用
所以最好不要使用ReDim Preserve 重新定义数组，可事先ReDim  重新定义下标充足的数组，或直接Dim声明一个固定大小的数组

Albert128

DataBus 发表于 2012-12-14 00:13
worksheetfunction transpose 可以帮助2维数组转置，但数组不能太大，你也可以自己写转置程序。

您好！我把3楼的修改了一下，想不用转置，为什么提示下标越界呢？
ReDim Preserve Brr(1 To 3,1 To m)改为ReDim Preserve Brr(1 To m, 1 To 3)感觉较直观

Albert128

zhaogang1960 发表于 2012-12-14 00:22
transpose 限制很多，且速度很慢，应尽量避免使用
所以最好不要使用ReDim Preserve 重新定义数组，可事先 ...

垦请赵版具体指导一下

DataBus

Albert128 发表于 2012-12-14 00:23
您好！我把3楼的修改了一下，想不用转置，为什么提示下标越界呢？
ReDim Preserve Brr(1 To 3,1 To m)改 ...

redim 只能改变第2维的维度。

Albert128

DataBus 发表于 2012-12-14 00:26
redim 只能改变第2维的维度。

大侠，您能否按赵版意思不使用“transpose和ReDim Preserve 重新定义数组”帮我修改一下代码呢！