求大神帮忙 已经接近尾声了

bao205540

求大神帮忙 “2”那个表里的项目 按需求填写到“台账2”里 并按车牌号生成 另一个新的总表 也就是说有多少车牌号 就有多少 车牌号命名的总表
详情就是表里1那样 只是 和2比又加了几项！ 还有就是表头的金额汇总的公式没了 ！
都是论坛里大神的帮助的结果！ 真的很不易！马上见日出了！
万分感谢！
又有加项了 新加的加油升数 和金额

WANT-T

提前祝贺你白嫖成功，么么哒

chxw68

1. Sub test()
   
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.     With Worksheets("sheet2")
   
9.         r = .Cells(.Rows.Count, 1).End(xlUp).Row
   
10.         arr = .Range("a2:m" & r)
    
11.         For i = 1 To UBound(arr)
    
12.             arr(i, 1) = CDate(arr(i, 1))
    
13.             yf = Month(arr(i, 1))
    
14.             rq = Day(arr(i, 1))
    
15.             If Not d.exists(arr(i, 4)) Then
    
16.                 Set d(arr(i, 4)) = CreateObject("scripting.dictionary")
    
17.             End If
    
18.             If Not d(arr(i, 4)).exists(0) Then
    
19.                 ReDim crr(1 To 6)
    
20.                 crr(1) = arr(i, 9)
    
21.                 crr(2) = arr(i, 4)
    
22.                 crr(3) = arr(i, 11)
    
23.             Else
    
24.                 crr = d(arr(i, 4))(0)
    
25.             End If
    
26.             If Not d(arr(i, 4)).exists(yf) Then
    
27.                 ReDim brr(1 To 7, 1 To 32)
    
28.             Else
    
29.                 brr = d(arr(i, 4))(yf)
    
30.             End If
    
31.             brr(1, rq) = brr(1, rq) + arr(i, 7)
    
32.             brr(2, rq) = brr(2, rq) + arr(i, 8)
    
33.             brr(3, rq) = arr(i, 10)
    
34.             brr(4, rq) = brr(4, rq) + arr(i, 6)
    
35.             brr(5, rq) = arr(i, 5)
    
36.             brr(6, rq) = arr(i, 12)
    
37.             brr(7, rq) = arr(i, 13)
    
38.             brr(1, 32) = brr(1, 32) + arr(i, 7)
    
39.             brr(2, 32) = brr(2, 32) + arr(i, 8)
    
40.             brr(4, 32) = brr(4, 32) + arr(i, 6)
    
41.             d(arr(i, 4))(yf) = brr
    
42.             crr(4) = crr(4) + arr(i, 7)
    
43.             crr(5) = crr(5) + arr(i, 8)
    
44.             crr(6) = crr(6) + arr(i, 6)
    
45.             d(arr(i, 4))(0) = crr
    
46.         Next
    
47.     End With
    
48.     For Each aa In d.keys
    
49.         With Worksheets("sheet1")
    
50.             crr = d(aa)(0)
    
51.             .Range("c2") = crr(1)
    
52.             .Range("k2") = crr(2)
    
53.             .Range("o2") = crr(3)
    
54.             .Range("t2") = crr(4)
    
55.             .Range("y2") = crr(5)
    
56.             .Range("ae2") = crr(6)
    
57.             For i = 4 To 92 Step 8
    
58.                 .Cells(i, 3).Resize(7, 32).ClearContents
    
59.             Next
    
60.             For Each bb In d(aa).keys
    
61.                 If bb <> 0 Then
    
62.                     brr = d(aa)(bb)
    
63.                     .Cells(bb * 8 - 4, 3).Resize(UBound(brr), UBound(brr, 2)) = brr
    
64.                 End If
    
65.             Next
    
66.             .Copy
    
67.             With ActiveWorkbook
    
68.                 .SaveAs Filename:=ThisWorkbook.Path & "" & aa
    
69.                 .Close False
    
70.             End With
    
71.         End With
    
72.     Next
    
73.    
    
74. End Sub
    

复制代码

bao205540

WANT-T 发表于 2023-2-27 10:50
提前祝贺你白嫖成功，么么哒

惭愧惭愧 形势所迫 非己所愿

chxw68

详见附件。

gwjkkkkk

你这个是我写的吧
1.增加的的应该也是自动汇总的，没看出来需要修改的。
2.公式这个位置金额已自动汇总了，这里不需要公式的，如果保留公式，少写代码一句即可.

bao205540

gwjkkkkk 发表于 2023-2-27 11:47
你这个是我写的吧
1.增加的的应该也是自动汇总的，没看出来需要修改的。
2.公式这个位置金额已自动汇总了 ...

是的 谢谢大神  增加了 油类的 表格也变了 所以 以前的代码用了  运行错误

bao205540

chxw68 发表于 2023-2-27 11:05

大神 车辆信息更新以后
这段出错
arr(i, 1) = CDate(arr(i, 1))
请问怎么修改

chxw68

bao205540 发表于 2023-2-27 13:30
大神 车辆信息更新以后
这段出错
arr(i, 1) = CDate(arr(i, 1))

A列可能不是日期数据。