希望表里的内容求和做成图片的样子

MaTch-

不同的仓库对应的列进行求和，并且输出在新的表里或者空白区域。
透视表可以做出来，想通过VBA的方法做一下，希望有朋友帮忙解决一下，。谢谢！

苏小亓

工作簿2.zip (16.3 KB, 下载次数: 5)

2019-8-2 10:23 上传

点击文件名下载附件

MaTch-

苏小亓 发表于 2019-8-2 10:23

谢谢！我知道用透视表可以做，我想有用VBA的方法做。

凌空一羽

Sub lkyy()
Set cnn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
cnn.Open "provider=microsoft.ace.oledb.12.0;extended properties='excel 12.0;hdr=yes';data source=" & ThisWorkbook.FullName
Sql = "select 仓库,sum(`4003091`) as 4003091,sum(`4003087`) as 4003087,sum(`4269879`) as 4269879,sum(`7035566`) as 7035566,sum(`7362620`) as 7362620,sum(`8022250`) as 8022250,sum(`8022262`) as 8022262 from [sheet1$a1:h] group by 仓库"
Set rs = cnn.Execute(Sql)
Range("j2").CopyFromRecordset cnn.Execute(Sql)
For i = 0 To rs.Fields.Count - 1
    Cells(1, i + 10) = rs.Fields(i).Name
Next
Set cnn = Nothing
Sheet2.Sort.SortFields.Clear
Range("j1").CurrentRegion.Sort "仓库", xlAscending, Header:=xlYes
Intersect(Range("k1:q1000"), Range("j1").CurrentRegion).Sort Range("k1:q1"), xlAscending, Header:=xlNo, Orientation:=xlLeftToRight
Sheet2.Sort.SortFields.Clear
End Sub

网海遨游

结果放在Sheet2表中


Sub test()
        Set sh1 = Sheets("sheet1")
       Set sh2 = Sheets("sheet2")
       sh2.Cells.Clear
       sh1.[a1:h1].Copy sh2.[a1]
        Set d = CreateObject("scripting.dictionary")
        arr = sh1.[a1].CurrentRegion
        For i = 2 To UBound(arr)
                s = arr(i, 1)
                If Not d.exists(s) Then
                    d(s) = Array(arr(i, 2), arr(i, 3), arr(i, 4), arr(i, 5), arr(i, 6), arr(i, 7), arr(i, 8))
                    Else
                    d(s) = Array(d(s)(0) + arr(i, 2), d(s)(1) + arr(i, 3), d(s)(2) + arr(i, 4), d(s)(3) + arr(i, 5), d(s)(4) + arr(i, 6), d(s)(5) + arr(i, 7), d(s)(6) + arr(i, 8))
                End If
        Next i
        Ik = d.keys
        Im = d.items
        sh2.[a2].Resize(d.Count) = Application.Transpose(Ik)
        For j = 1 To 8
            sh2.Cells(j + 1, 2).Resize(, 7) = Im(j - 1)
        Next j
End Sub

MaTch-

网海遨游 发表于 2019-8-2 10:50
结果放在Sheet2表中

调试了是我想要的结果，有一个问题是，如果我的列数特别多的话，可以怎么让列进行循环呢？

网海遨游

那我还要思考下。

MaTch-

网海遨游 发表于 2019-8-2 11:18
把附件也上传下。

展示的列是8列，其实我数据源的列还是挺多的，就是想怎么把列也加入到循环里，
If Not d.exists(s) Then
                    d(s) = Array(arr(i, 2), arr(i, 3), arr(i, 4), arr(i, 5), arr(i, 6), arr(i, 7), arr(i, 8))
                    Else
                    d(s) = Array(d(s)(0) + arr(i, 2), d(s)(1) + arr(i, 3), d(s)(2) + arr(i, 4), d(s)(3) + arr(i, 5), d(s)(4) + arr(i, 6), d(s)(5) + arr(i, 7), d(s)(6) + arr(i, 8))
                End If
就是这部分可以做成循环吗

网海遨游

MaTch- 发表于 2019-8-2 11:25
展示的列是8列，其实我数据源的列还是挺多的，就是想怎么把列也加入到循环里，
If Not d.exists(s) Then ...

前半部分能办到，后半部分涉及数组内套字典，俺功力太浅，未能实现。期待高手出手 ……

MaTch-

网海遨游 发表于 2019-8-2 12:47
前半部分能办到，后半部分涉及数组内套字典，俺功力太浅，未能实现。期待高手出手 ……

好的，还是非常感谢你！