双条件筛选汇总

良良

seduse 发表于 2022-11-2 21:25
谢谢！好像实现不了？是不是我哪里操作不对？

录入公式后，三键：CTRL+SHIFT+ENTER结束。

盼盼198310

seduse 发表于 2022-11-2 21:24
感谢！
还想问一下，如果还有需要根据实际情况调整，可以怎么调整这个宏？？

只要数据源的结构不变,是不用调整的

3190496160

Sub hz()
Application.ScreenUpdating = False
Dim ar As Variant, cr As Variant
Dim i As Long, rs As Long
Dim br()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Sheets("sheet1")
    rs = .Cells(Rows.Count, 1).End(xlUp).Row
    ar = .Range("a2:d" & rs)
    ReDim br(1 To UBound(ar), 1 To UBound(ar, 2))
    For i = 2 To UBound(ar)
        If Trim(ar(i, 1)) <> "" And Trim(ar(i, 3)) <> "" Then
            If ar(i, 2) > 0 Then
                zd = Trim(ar(i, 1)) & "|" & Trim(ar(i, 3))
                t = d(zd)
                If t = "" Then
                    k = k + 1
                    d(zd) = k
                    t = k
                    br(k, 1) = ar(i, 1)
                    br(k, 3) = ar(i, 3)
                End If
                br(t, 2) = br(t, 2) + ar(i, 2)
                br(t, 4) = br(t, 4) + ar(i, 4)
            End If
        End If
    Next i
    r = .Cells(Rows.Count, 6).End(xlUp).Row
    If r > 2 Then
        .Range("f3:i" & r).Borders.LineStyle = 0
        .Range("f3:i" & r) = Empty
    End If
    .[f3].Resize(k, UBound(br, 2)) = br
    .[f3].Resize(k, UBound(br, 2)).Borders.LineStyle = 1
End With
MsgBox "ok!"
End Sub

3190496160

数量余额汇总.rar (19.72 KB, 下载次数: 3)

2022-11-3 14:18 上传

点击文件名下载附件

seduse

良良 发表于 2022-11-2 21:28
录入公式后，三键：CTRL+SHIFT+ENTER结束。

G3=SUMIFS(B:B,A:A,F3,C:C,H3)
I3=SUMIFS(D:D,A:A,F3,C:C,H3,D:D,">0")
H3=IFERROR(INDEX(C:C,SMALL(IF((A$3:A$23=F3)*(MATCH(A$3:A$23&C$3:C$23,A$3:A$23&C$3:C$23,)=ROW($1:$21)),ROW($3:$23)),COUNTIF(F$3:F3,F3))),"")

录入公式后，三键：CTRL+SHIFT+ENTER结束

这次可以了，数据完美！感谢大神指点！！！！

seduse

盼盼198310 发表于 2022-11-3 07:32
只要数据源的结构不变,是不用调整的

好的，谢谢！

seduse

3190496160 发表于 2022-11-3 14:17
Sub hz()
Application.ScreenUpdating = False
Dim ar As Variant, cr As Variant

非常感谢大神！！！