数据汇总

机智

老师们晚上好啊，有一个汇总问题想各位帮帮忙。

具体如附件所示，问题不难，很容易的，我知道大致原理，但是不会写。
谢谢各位
汇总.zip (678.05 KB, 下载次数: 16)

2023-7-12 20:11 上传

点击文件名下载附件

鄂龙蒙

【名称规格】有重复？要汇总？

ykcbf1100

用了二级字典，附件供参考。。。

chxw68

详见附件。

liulang0808

Sub test()
    Set d = CreateObject("scripting.dictionary")
    Set fso = CreateObject("scripting.filesystemobject")
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set sh = ThisWorkbook.Sheets("汇总")
    sh.UsedRange.ClearContents
    c = 1
    For Each f In fso.getfolder(ThisWorkbook.Path).Files
        If InStr(f.Name, ThisWorkbook.Name) = 0 Then
            With Workbooks.Open(f)
                arr = .Sheets(1).UsedRange
                .Close False
            End With
            d.RemoveAll
            For j = 2 To UBound(arr)
                If Len(arr(j, 15)) > 0 Then
                    d(arr(j, 15)) = d(arr(j, 15)) + Val(arr(j, 22))
                End If
            Next j
            sh.Cells(1, c) = fso.getbasename(f.Name)
            sh.Cells(2, c).Resize(1, 2) = Array("规格", "数量")
            If d.Count > 0 Then
                Cells(3, c).Resize(d.Count) = WorksheetFunction.Transpose(d.keys)
                Cells(3, c + 1).Resize(d.Count) = WorksheetFunction.Transpose(d.items)
            End If
            c = c + 2
        End If
    Next
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

liulang0808

。。。。。。。。。。。。 汇总.zip (630.61 KB, 下载次数: 8)

2023-7-12 21:15 上传

点击文件名下载附件

机智

鄂龙蒙 发表于 2023-7-12 20:44
【名称规格】有重复？要汇总？

名称规格有很多重复的，字典去重，然后根据去重后的规格名称去汇总数量

机智

ykcbf1100 发表于 2023-7-12 21:03
用了二级字典，附件供参考。。。

谢谢老师的回复，我将会认真查看，鲜花明日送上，今天没有了。
感激您。谢谢您。

机智

chxw68 发表于 2023-7-12 21:04
详见附件。

谢谢老师的回复，我将会认真查看，鲜花明日送上，今天没有了。
感激您。谢谢您。

机智

liulang0808 发表于 2023-7-12 21:16
。。。。。。。。。。。。

谢谢老师的回复，我将会认真查看，鲜花明日送上，今天没有了。
感激您。谢谢您。