提取部分字段汇总

一把小刀闯天下

如云家家 发表于 2019-10-22 14:29
A21是单元格，测试后，A21 是“品名”A22是“224”，是不对的，应该是497B，B21“3月”，不对应该是1月， ...

肯定看不懂。还是上附件吧，如果能看懂给你再修改

品名在B列，你为什么把它放A列去处理，，，

xiangbaoan

………………

如云家家

xiangbaoan 发表于 2019-10-22 15:12
………………

谢谢，完美解决了

xiangbaoan

如云家家 发表于 2019-10-22 15:36
谢谢，完美解决了

小刀老师的不也是非常完美吗?
arr = Sheets("汇总").[a1].CurrentRegion
Sheets("分类汇总").[a1].Resize(m + 1, n + 1) = brr
加上红色部分对你来说应该不难哟。

一把小刀闯天下

xiangbaoan 发表于 2019-10-22 15:54
小刀老师的不也是非常完美吗?
arr = Sheets("汇总").[a1].CurrentRegion
Sheets("分类汇总").[a1].Resi ...

没有老师之说，我来这里就是学VBA的，只是方式上可能跟别人不一样。非常感谢

我还一直盯着品名与汇总数据是否准确的，没想到是输出数据覆盖了源数据。以后敲代码时要多测试一下，，，

everbest2015

1，想按“品名”中第一个空格前的内容分类汇总，例如：开头是497B的，1月数量：6+6+215＝224
效果在分类汇总工作表中    这句话描述欠妥

everbest2015

公式走一波   =SUMIF(汇总!$B:$B,分类汇总!$A2&"*",OFFSET(汇总!$A$1,,MATCH(B$1&"累计数量",汇总!$1:$1,)-1))

everbest2015

Sub tt()
        Dim sh As Worksheet, ar, d As Object, i&, r&, c&, j&, s$
        ThisWorkbook.Activate
        Set sh = Sheet1
        With sh
                If .AutoFilterMode Then .AutoFilterMode = False
                r = .Cells(.Rows.Count, "a").End(xlUp).Row
                c = .Cells(1, .Columns.Count).End(xlToLeft).Column
                If r < 2 Then Exit Sub
                ar = .Range("a1").Resize(r, c)
                Set d = CreateObject("Scripting.Dictionary")
                For i = 2 To UBound(ar)
                        If ar(i, 1) <> "" Then
                               For j = 4 To UBound(ar, 2)
                                     s = Split(ar(i, 2), " ")(0) & "," & ar(1, j)
                                     d(s) = d(s) + Val(ar(i, j))
                               Next
                        End If
                Next
                If d.Count = 0 Then Exit Sub
        End With
        Set sh = Sheet2
        Erase ar
        With sh
                If .AutoFilterMode Then .AutoFilterMode = False
                .UsedRange.Offset(1, 1).ClearContents
                ar = .Range("a1").CurrentRegion
                For i = 2 To UBound(ar)
                        If ar(i, 1) <> "" Then
                            For j = 2 To UBound(ar, 2)
                                    s = ar(i, 1) & "," & ar(1, j) & "累计数量"
                                    If d.exists(s) Then ar(i, j) = d(s)
                            Next
                        End If
                Next
                .Range("a1").CurrentRegion = ar
                 Set d = Nothing
        End With
End Sub

everbest2015

代码在审核中, 先上一张图片