请哪位朋友帮忙设计一下代码

xuweiwei008

求助内容：
请帮忙设计红色区域的数据获取按钮代码

ETC车辆通行明细从“sheet2”表中获得
点击获取数据按钮
分别将对应车辆类型的车辆总数以及实收金额的和汇总到当前表格对应的单元格中

雪舞子

只统计了“ETC专用道”，如需统计全部可删除相应的IF语句。

1. Private Sub CommandButton1_Click()
   
2.     Dim arr, crr, brr(), d As Object, i&
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     crr = [b5:b16]: crr(1, 1) = crr(2, 1)
   
5.     ReDim brr(1 To UBound(crr), 1 To 2)
   
6.     With Workbooks.Open(ThisWorkbook.Path & "" & "Sheet2.xls")
   
7.         arr = .Sheets(1).Range("a1").CurrentRegion
   
8.         .Close False
   
9.     End With
   
10.     For i = 2 To UBound(arr)
    
11.         If arr(i, 3) = "ETC专用道" Then  '统计ETC专用道
    
12.             If d.exists(arr(i, 6)) Then
    
13.                 d(arr(i, 6)) = Array(d(arr(i, 6))(0) + 1, d(arr(i, 6))(1) + Val(arr(i, 10)))
    
14.             Else
    
15.                 d(arr(i, 6)) = Array(1, Val(arr(i, 10)))
    
16.             End If
    
17.         End If
    
18.     Next
    
19.     For i = 1 To UBound(crr)
    
20.         If d.exists(crr(i, 1)) Then
    
21.             brr(i, 1) = d(crr(i, 1))(0)
    
22.             brr(i, 2) = d(crr(i, 1))(1)
    
23.         End If
    
24.     Next
    
25.     [e5:f16] = ""
    
26.     [e5:f16] = brr
    
27. End Sub

复制代码

求助.rar (21.48 KB, 下载次数: 3)

2017-4-2 10:15 上传

点击文件名下载附件