求高手写一代码

yangyangzhifeng

云朵中的民族 发表于 2013-1-4 18:28
老师你好，目前还没研究透你的代码，我想在报表里增加两列，显示车型和所属单位，麻烦老师帮忙再修改一下 ...

试试看，我是照以前的附件修改的代码，你自己将工作表名称调整一下

yangyangzhifeng

忘了贴代码，干脆工作表名称也修改了

1. Sub test()
   
2.     Dim ar, br, i&, j&, cp$, n&, lc, mt
   
3.     Sheets("高级筛选").Select
   
4.     Sheets("高级筛选").Range("a4:s" & Sheets("高级筛选").Range("a65536").End(3).Row).Sort key1:=[f4], key2:=[n4], header:=xlYes
   
5.     ar = Sheets("高级筛选").Range("a4:s" & Sheets("高级筛选").Range("a65536").End(3).Row)
   
6.     ReDim br(1 To UBound(ar), 1 To 10)
   
7.     '    n = 1: cp = ar(2, 6): lc = ar(2, 18)
   
8.     For i = 2 To UBound(ar)
   
9.         If ar(i, 6) <> cp Then
   
10.             n = n + 1: cp = ar(i, 6)
    
11.             br(n, 1) = cp
    
12.             br(n, 4) = 1: br(n, 5) = ar(i, 15): br(n, 6) = ar(i, 16)
    
13.             br(n, 2) = ar(i, 7): br(n, 3) = ar(i, 9)
    
14.             If n > 1 Then
    
15.                 br(n - 1, 7) = br(n, 7) + ar(i - 1, 18) - lc
    
16.                 If mt <> "" Then br(n - 1, 8) = ar(i - 1, 19) - mt
    
17.                 If br(n - 1, 7) <> 0 Then br(n - 1, 9) = br(n - 1, 6) * 100 / br(n - 1, 7)
    
18.                 If br(n - 1, 8) > 0 Then br(n - 1, 10) = br(n - 1, 6) / br(n - 1, 8)
    
19.             End If
    
20.             lc = ar(i, 18): mt = ar(i, 19)
    
21.         Else
    
22.             br(n, 4) = br(n, 4) + 1
    
23.             br(n, 5) = br(n, 5) + ar(i, 15)
    
24.             br(n, 6) = br(n, 6) + ar(i, 16)
    
25.             If i > 2 Then
    
26.                 If ar(i, 18) < ar(i - 1, 18) Then
    
27.                     br(n, 7) = br(n, 7) + ar(i - 1, 18) - lc: lc = 0
    
28.                 End If
    
29.             End If
    
30.         End If
    
31.     Next
    
32.     br(n, 7) = br(n, 7) + ar(i - 1, 18) - lc
    
33.     If mt <> "" Then br(n, 8) = ar(i - 1, 19) - mt
    
34.     If br(n, 7) Then br(n, 9) = br(n, 6) * 100 / br(n, 7)
    
35.     If br(n, 8) > 0 Then br(n, 10) = br(n, 6) / br(n, 8)
    
36.     If Sheets("统计报表").Range("a65536").End(3).Row > 1 Then Sheets("统计报表").Range("a2:h" & Sheets("统计报表").Range("a65536").End(3).Row).ClearContents
    
37.     Sheets("统计报表").Range("a2").Resize(n, 8) = br
    
38.     Sheets("统计报表").Select
    
39. End Sub

复制代码

云朵中的民族

yangyangzhifeng 发表于 2013-1-4 19:17
忘了贴代码，干脆工作表名称也修改了

谢谢您了！

云朵中的民族

yangyangzhifeng 发表于 2013-1-4 19:17
忘了贴代码，干脆工作表名称也修改了

老师你好，刚测试了一下，后面两个油耗没能计算出来，请老师帮忙再检查一下，另外请老师帮忙看看下面帖子的附件，谢谢！
http://club.excelhome.net/thread-966552-1-1.html

云朵中的民族

云朵中的民族 发表于 2013-1-4 20:31
谢谢您了！

If Sheets("统计报表").Range("a65536").End(3).Row > 1 Then Sheets("统计报表").Range("a2:h" & Sheets("统计报表").Range("a65536").End(3).Row).ClearContents
    Sheets("统计报表").Range("a2").Resize(n, 8) = br
找到问题所在了，是这个地方没改过来：a2:j     n, 10请老师给看看那个帖子的附件，谢谢！