怎样用VBA代码实现某两列汇总求和

小石榴123 · 发表于 2016-8-30 12:46

求助高手，怎样用VBA实现对左边A到E列数据按G到J列的模式求和，因数据量比较大，这只是一部分，而且希望自动计算，所以没用数据透视表，哪位高手能帮帮我，万分感激

chxw68 · 发表于 2016-8-30 12:52

Sub test1() '字典法
Dim r%, i%
Dim arr, brr
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Worksheets("sheet1")
r = .Cells(.Rows.Count, 1).End(xlUp).Row
arr = .Range("a2:e" & r)
For i = 1 To UBound(arr)
xm = arr(i, 1) & "+" & arr(i, 2)
If Not d.exists(xm) Then
ReDim brr(1 To 4)
brr(1) = arr(i, 1)
brr(2) = arr(i, 2)
Else
brr = d(xm)
End If
brr(3) = brr(3) + arr(i, 4)
brr(4) = brr(4) + arr(i, 5)
d(xm) = brr
Next
.Range("g2").Resize(d.Count, 4) = Application.Transpose(Application.Transpose(d.items))
End With
End Sub

复制代码

chxw68 · 发表于 2016-8-30 12:55

Sub test2() 'ADO+SQL法
Dim cnn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim sql As String
Dim mybook As String
mybook = ThisWorkbook.FullName
With cnn
If Application.Version = "11.0" Then
.Provider = "microsoft.jet.oledb.4.0"
.ConnectionString = "extended properties=""excel 8.0;HDR=YES;"";data source=" & mybook
Else
.Provider = "microsoft.ACE.oledb.12.0"
.ConnectionString = "extended properties=""excel 12.0;HDR=YES;"";data source=" & mybook
End If
.Open
End With
sql = "select zhanhao,date,sum(millitm),sum(value) from [sheet1$a1:e] group by zhanhao,date"
rs.Open sql, cnn, adOpenKeyset, adLockOptimistic
With Worksheets("sheet1")
.Range("k2").CopyFromRecordset rs
End With
End Sub

复制代码

chxw68 · 发表于 2016-8-30 12:56

详见附件。

小石榴123 · 发表于 2016-8-30 12:59

chxw68 发表于 2016-8-30 12:56
详见附件。

真是太感谢您了，我down下好好研究研究

hushiyong11 · 发表于 2021-1-7 09:02

向高手至敬

吓你一跳 · 发表于 2022-2-25 17:35

向高手学习了

dogfire4169 · 发表于 2023-3-7 23:36

chxw68 发表于 2016-8-30 12:52

如果改求平均要如何做？？？？

有大大能教一下吗？？？

xunanming · 发表于 2023-3-8 04:03

高手如云,学无止境,向大佬们学习!!!

		自动登录	找回密码
密码			免费注册

[求助] 怎样用VBA代码实现某两列汇总求和