求各位大神帮帮忙，按条件提取，每月的销售总额

黛小小

求大神帮帮忙

3190496160

Sub test()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Sheet1
    ws = .Cells(Rows.Count, 2).End(xlUp).Row
    ar = .Range("b2:d" & ws)
    .Range("h2:j" & UBound(ar)) = Empty
    br = .Range("g1:j" & UBound(ar))
    For j = 2 To UBound(br, 2)
        If Trim(br(1, j)) <> "" Then
            s = Format(br(1, j), "yyyym")
            d(s) = j
        End If
    Next j
    k = 1
    For i = 2 To UBound(ar)
        If Trim(ar(i, 1)) <> "" Then
            t = d(Trim(ar(i, 1)))
            If t = "" Then
                k = k + 1
                d(Trim(ar(i, 1))) = k
                t = k
                br(k, 1) = ar(i, 1)
            End If
            s_1 = Format(ar(i, 2), "yyyym")
            m = d(s_1)
            If m <> "" Then
                br(t, m) = br(t, m) + ar(i, 3)
            End If
        End If
    Next i
    .Range("g1:j" & UBound(ar)) = br
End With
End Sub

3190496160

救助表.rar (13.87 KB, 下载次数: 3)

2020-3-1 11:59 上传

点击文件名下载附件

黛小小

谢谢大神  已解决

3190496160

换个思路，精简了代码
Sub test()
Dim d As Object
Dim br()
Set d = CreateObject("scripting.dictionary")
With Sheet1
    ws = .Cells(Rows.Count, 2).End(xlUp).Row
    ar = .Range("b1:d" & ws)
    .Range("h2:y" & UBound(ar)) = Empty
    kk = 1: k = 1
    ReDim Preserve br(1 To UBound(ar), 1 To kk)
    For i = 2 To UBound(ar)
        If Trim(ar(i, 1)) <> "" Then
            t = d(Trim(ar(i, 1)))
            If t = "" Then
                k = k + 1
                d(Trim(ar(i, 1))) = k
                t = k
                br(k, 1) = ar(i, 1)
            End If
            s_1 = Format(ar(i, 2), "yyyym")
            If Not d.exists(s_1) Then
                kk = kk + 1
                ReDim Preserve br(1 To UBound(ar), 1 To kk)
                br(1, kk) = s_1
                br(t, kk) = ar(i, 3)
                d(s_1) = kk
            ElseIf d.exists(s_1) Then
                br(t, d(s_1)) = br(t, d(s_1)) + ar(i, 3)
            End If
        End If
    Next i
    .Range("g1").Resize(k, kk) = br
End With
MsgBox "ok!"
End Sub

3190496160

救助表.rar (16.45 KB, 下载次数: 3)

2020-3-1 12:28 上传

点击文件名下载附件

moira2004

我的方法是先透视一下，然后复制，另一目标单远格选择性粘贴里转置一下，就可以了。

gykg-excel

=SUMPRODUCT((MONTH(C$17)=MONTH($C$2:$C$13))*($B$2:$B$13=$B18)*$D$2:$D$13)