数组中如何求和

allwin88

各位前辈

数组中如何求和？

麻烦指教，感谢啦！~

allwin88

补充：求和结果是新增在数组中，不是单元格里。

hdbk

Sub docnn()
Dim cnn As Object, i%, j%, x%, rs As Object, arr, brr
Set cnn = CreateObject("adodb.connection")
cnn.Open "provider=microsoft.ace.oledb.12.0;extended properties=excel 12.0; data source=" & ThisWorkbook.FullName
Sql = "select 料号,sum(数量) as 求和 from [Sheet1$a1:b10] group by 料号"
Set rs = cnn.Execute(Sql)
For i = 0 To rs.fields.Count - 1
    Cells(1, i + 7) = rs.fields(i).Name
Next
Range("g2").CopyFromRecordset rs
arr = Range("a1:c10")
brr = Range("g1:h8")
  For j = 2 To UBound(arr)
     For x = 2 To UBound(brr)
     If arr(j, 1) = brr(x, 1) Then
        arr(j, 3) = brr(x, 2)
    End If
    Next
Next
Range("a1").Resize(UBound(arr), 3) = arrRange(Cells(1, 5), Cells(100, 15)).Clear
rs.Close: Set rs = Nothing
cnn.Close: Set cnn = Nothing
End Sub

hdbk

Sub docnn()
Dim cnn As Object, i%, j%, x%, rs As Object, arr, brr
Set cnn = CreateObject("adodb.connection")
cnn.Open "provider=microsoft.ace.oledb.12.0;extended properties=excel 12.0; data source=" & ThisWorkbook.FullName
Sql = "select 料号,sum(数量) as 求和 from [Sheet1$a1:b10] group by 料号"
Set rs = cnn.Execute(Sql)
For i = 0 To rs.fields.Count - 1
    Cells(1, i + 7) = rs.fields(i).Name
Next
Range("g2").CopyFromRecordset rs
arr = Range("a1:c10")
brr = Range("g1:h8")
  For j = 2 To UBound(arr)
     For x = 2 To UBound(brr)
     If arr(j, 1) = brr(x, 1) Then
        arr(j, 3) = brr(x, 2)
    End If
    Next
Next
Range("a1").Resize(UBound(arr), 3) = arr
Range(Cells(1, 5), Cells(100, 15)).Clear
rs.Close: Set rs = Nothing
cnn.Close: Set cnn = Nothing
End Sub

allwin88

hdbk 发表于 2018-10-3 13:38
Sub docnn()
Dim cnn As Object, i%, j%, x%, rs As Object, arr, brr
Set cnn = CreateObject("adodb.co ...

感谢，没想到通过数组要写这么多，在表格里直接一个sumifs就解决了。
是否可以结合字典来写？
数据库真是博大~

abc123281

没见过这样求和的   以下代码仅供参考

Sub test()
Dim arr, brr(1 To 10000, 1 To 2)
Set d = CreateObject("scripting.dictionary")
rw = [a65536].End(xlUp).Row
arr = Range("a2:c" & rw)
For i = 1 To UBound(arr)
   If Not d.exists(arr(i, 1)) Then
      n = n + 1
      d(arr(i, 1)) = n
      For j = 1 To 2
         brr(n, j) = arr(i, j)
      Next
   Else
      m = d(arr(i, 1))
      brr(m, 2) = brr(m, 2) + arr(i, 2)
   End If
Next
Cells(2, "g").Resize(n, 2) = brr
End Sub