请教代码，错在哪里？

烟火孤星泪

运行时提示错误，是对象不对吗？

1. Sub 批量生成()
   
2.     Dim r%, i%
   
3.     Dim arr, brr
   
4.     Dim d As Object
   
5.     Application.ScreenUpdating = False
   
6.     Application.DisplayAlerts = False
   
7.     Set d = CreateObject("scripting.dictionary")
   
8.     Set d1 = CreateObject("scripting.dictionary")
   
9.     With Worksheets("消费明细")
   
10.        .AutoFilterMode = False
    
11.         r =.Cells(.Rows.Count, 1).End(xlUp).Row
    
12.         arr =.Range("a2:g" & r)
    
13.     End With
    
14.     For i = 1 To UBound(arr)
    
15.         rq = DateValue(arr(i, 5))
    
16.         sj = TimeValue(arr(i, 5))
    
17.         If Not d.exists(arr(i, 7)) Then
    
18.             Set d(arr(i, 7)) = CreateObject("scripting.dictionary")
    
19.         End If
    
20.         If Not d(arr(i, 7)).exists(arr(i, 3)) Then
    
21.             Set d(arr(i, 7))(arr(i, 3)) = CreateObject("scripting.dictionary")
    
22.         End If
    
23.         If Not d(arr(i, 7))(arr(i, 3)).exists(rq) Then
    
24.             ReDim brr(1 To 11)
    
25.             brr(1) = arr(i, 3)
    
26.             brr(2) = arr(i, 4)
    
27.             brr(3) = rq
    
28.             brr(11) = arr(i, 7)
    
29.         Else
    
30.             brr = d(arr(i, 7))(arr(i, 3))(rq)
    
31.         End If
    
32.         n = 0
    
33.         If sj >= #5:00:00 PM# Then
    
34.             n = 4
    
35.         ElseIf sj >= #11:00:00 AM# And sj <= #1:00:00 PM# Then
    
36.             n = 5
    
37.         ElseIf sj >= #6:30:00 AM# And sj <= #9:00:00 AM# Then
    
38.             n = 6
    
39.         End If
    
40.         If n <> 0 Then
    
41.             brr(n) = brr(n) + Val(arr(i, 6))
    
42.         End If
    
43.         d(arr(i, 7))(arr(i, 3))(rq) = brr
    
44.     Next
    
45.     ReDim crr(1 To d1.Count, 1 To 10)
    
46.     ReDim drr(1 To 10)
    
47.     drr(1) = "合计"
    
48.     m = 0
    
49.     For Each aa In d1.keys
    
50.         brr = d1(aa)
    
51.         For j = 7 To 9
    
52.             brr(10) = brr(10) + brr(j)
    
53.         Next
    
54.         m = m + 1
    
55.         For j = 1 To UBound(brr)
    
56.             crr(m, j) = brr(j)
    
57.         Next
    
58.         For j = 2 To 10
    
59.             drr(j) = drr(j) + brr(j)
    
60.         Next
    
61.     Next
    
62.     With Worksheets("全校统计")
    
63.        .Select
    
64.        .UsedRange.Offset(1, 0).Clear
    
65.        .Range("a2").Resize(UBound(crr), UBound(crr, 2)) = crr
    
66.        .Cells(1 + UBound(crr) + 1, 1).Resize(1, UBound(drr)) = drr
    
67.         With.Range("a1").Resize(1 + UBound(crr) + 1, UBound(crr, 2))
    
68.            .Borders.LineStyle = xlContinuous
    
69.             With.Font
    
70.                .Name = "微软雅黑"
    
71.                .Size = 11
    
72.             End With
    
73.            .HorizontalAlignment = xlCenter
    
74.            .VerticalAlignment = xlCenter
    
75.         End With
    
76.     End With
    
77.     Application.ScreenUpdating = True
    
78.     MsgBox "所有报表已生成！"
    
79. End Sub</span>

复制代码

zxsea_7426

ReDim crr(1 To d1.Count, 1 To 10)第一行就报错了

zxsea_7426

第一行与第二行中间省略了N行代码了吧


整体看下来了。这代码无头无脑的啊

ykcbf1100

For Each aa In d1.keys
这一行代码前面没有字典操作的经过，显然你把前面的代码删除了。

lsc900707

改的面目全非然后来个无厘头求助！