VBA里编写用数组进行多条件汇总求和

1150785498

各位大师大家好，小弟是一个初学VBA编程的小生，代码写到一半了，再往下不会了，想求助各位老师帮忙。怎样才能实现在数组了面多条件分类汇总求和，最后的效果如附件所示！因为数据量太大所以急求~~~~~~~小弟在这里跪谢了！！！！

网海遨游

数组+字典完成。检测比例那个，不知如何得到，未给你计算。
Sub test()
        Dim arr, i%, d(1 To 9) As Object, sh As Worksheet, sht As Worksheet, j%, k%, s
        Set sh = Sheets("数据源")'你数据源表名“数据源”的源后有一空格，请删除，否则此处报错。
        Set sht = Sheets("汇总表")
        sht.Range("a3:i60000").ClearContents
        arr = sh.[a1].CurrentRegion
        For i = 1 To 9
                Set d(i) = CreateObject("scripting.dictionary")
        Next i
        For j = 2 To UBound(arr)
                s = arr(j, 6)
                d(1)(s) = arr(j, 1)
                d(2)(s) = arr(j, 2)
                d(3)(s) = arr(j, 3)
                d(4)(s) = d(4)(s) + arr(j, 4)
                d(5)(s) = d(5)(s) + arr(j, 5)
                d(6)(s) = arr(j, 6)
                d(7)(s) = d(7)(s) + arr(j, 7)
                d(8)(s) = d(8)(s) + arr(j, 8)
                d(9)(s) = d(9)(s) + arr(j, 9)
        Next j
        For k = 1 To 9
                sht.Cells(3, k).Resize(d(k).Count) = Application.Transpose(d(k).items)
        Next k
End Sub

w609053988

字典+数组比较合适，标题可以手动做好

蓝桥玄霜

多条件统计的代码：

凌空一羽

Sub lkyy()
Set cnn = CreateObject("ADODB.Connection")
cnn.Open "provider=microsoft.ace.oledb.12.0;extended properties=excel 12.0;data source=" & ThisWorkbook.FullName
Sql = "select 管道编号,材质,`规  格mm`,sum(焊口总数) as 焊口总数,sum(固定口) as 固定口,施焊焊工,sum(施焊数量) as 施焊数量,sum(已检测总数) as 已检测总数,sum(已检测固定口数) as 已检测固定口数 from [数据源 $a:i]  "
Sql = Sql & " group by 管道编号,材质,`规  格mm`,施焊焊工"
Range("a3").CopyFromRecordset cnn.Execute(Sql)
Set cnn = Nothing
End Sub

w609053988

凌空一羽 发表于 2019-8-8 11:08
Sub lkyy()
Set cnn = CreateObject("ADODB.Connection")
cnn.Open "provider=microsoft.ace.oledb.12.0; ...

ADO+SQL这个方法更好更方便

一把小刀闯天下

Option Explicit

Sub test()
  Dim arr, pos(1), i, j, k, m, t, dic
  Set dic = CreateObject("scripting.dictionary")
  pos(0) = Array(1, 2, 3, 6)
  pos(1) = Array(4, 5, 7, 8, 9)
  arr = Sheets("数据源 ").[a1].CurrentRegion.Offset(1).Resize(, 10)
  For i = 1 To UBound(arr, 1) - 1
    t = arr(i, pos(0)(0))
    For j = 1 To UBound(pos(0))
      t = t & arr(i, pos(0)(j))
    Next
    If dic.exists(t) Then
      For k = 0 To UBound(pos(1))
        arr(dic(t), pos(1)(k)) = arr(dic(t), pos(1)(k)) + arr(i, pos(1)(k))
      Next
    Else
      m = m + 1: dic(t) = m
      For k = 1 To UBound(arr, 2) - 1
        arr(m, k) = arr(i, k)
      Next
    End If
  Next
  For i = 1 To m
    If arr(i, 8) <> 0 Then arr(i, 10) = arr(i, 4) / arr(i, 8) * 100
  Next
  With Sheets("汇总表").[a3]
    .Resize(Rows.Count - 2, UBound(arr, 2) + 1).ClearContents
    .Resize(m, UBound(arr, 2)) = arr
  End With
End Sub

1150785498

网海遨游 发表于 2019-8-8 11:00
数组+字典完成。检测比例那个，不知如何得到，未给你计算。
Sub test()
        Dim arr, i%, d(1 To 9)  ...

你给的这个代码，用我自己加入到数组的数据，计算不了，不过还是非常感谢你在百忙之中帮助我！！！非常感谢

1150785498

w609053988 发表于 2019-8-8 11:02
字典+数组比较合适，标题可以手动做好

谢谢你的帮助！！但是字典还没能学明白，还在学习当中。

1150785498

蓝桥玄霜 发表于 2019-8-8 11:03
多条件统计的代码：

谢谢你的帮助，谢谢！！！