[已解决]接着求解

jianjuneng38

在这个表中 设置12个月求和 怎么会产生下标越界 请大侠详细指点下哪里出错了 再把代码修正下 谢谢

最佳答案

月排行榜 / 总排行榜

银鱼

2012-7-12 09:42

1. 
   
2. Private Sub CommandButton4_Click()
   
3. Dim d As New Dictionary
   
4. Dim 汇总表单(1 To 10000, 1 To 13)
   
5. Dim 行数, 列数
   
6. Dim arr, x, k, y
   
7. arr = Sheets("数据源").Range("a3:h" & Sheets("数据源").Range("b65536").End(xlUp).Row)
   
8. For x = 1 To UBound(arr)
   
9.     列数 = (InStr("1月2月3月4月5月6月7月8月9月101112", Month(arr(x, 2))) + 1) / 2 + 1
   
10.    If d.Exists(arr(x, 5)) Then
    
11.       行数 = d(arr(x, 5))
    
12.       
    
13.       汇总表单(行数, 列数) = 汇总表单(行数, 列数) + arr(x, 7)
    
14.    Else
    
15.       k = k + 1
    
16.       d(arr(x, 5)) = k
    
17.       汇总表单(k, 1) = arr(x, 5)
    
18.       汇总表单(k, 列数) = arr(x, 7)
    
19.    End If
    
20. Next x
    
21. Sheets("数据汇总").Range("b13").Resize(k, 13) = 汇总表单
    
22. End Sub
    

复制代码

跳转到最佳答案楼层

ztccsj

汇总表单(行数, 列数) = 汇总表单(行数, 列数) + arr(x, 7)
在以上位置出了问题，你调试下看看

dongqing1998

Dim 汇总表单(1 To 10000, 1 To 13)
把上面的定义改为
Dim 汇总表单(1 To 10000, 1 To 14)

其他的没仔细看

银鱼

1. 
   
2. Private Sub CommandButton4_Click()
   
3. Dim d As New Dictionary
   
4. Dim 汇总表单(1 To 10000, 1 To 13)
   
5. Dim 行数, 列数
   
6. Dim arr, x, k, y
   
7. arr = Sheets("数据源").Range("a3:h" & Sheets("数据源").Range("b65536").End(xlUp).Row)
   
8. For x = 1 To UBound(arr)
   
9.     列数 = (InStr("1月2月3月4月5月6月7月8月9月101112", Month(arr(x, 2))) + 1) / 2 + 1
   
10.    If d.Exists(arr(x, 5)) Then
    
11.       行数 = d(arr(x, 5))
    
12.       
    
13.       汇总表单(行数, 列数) = 汇总表单(行数, 列数) + arr(x, 7)
    
14.    Else
    
15.       k = k + 1
    
16.       d(arr(x, 5)) = k
    
17.       汇总表单(k, 1) = arr(x, 5)
    
18.       汇总表单(k, 列数) = arr(x, 7)
    
19.    End If
    
20. Next x
    
21. Sheets("数据汇总").Range("b13").Resize(k, 13) = 汇总表单
    
22. End Sub
    

复制代码

银鱼

代码修正了，检查下。instr取数的地方少了一个  "月"
不过代码写的不错，学习下！

jianjuneng38

谢谢楼上的兄弟 。。。