[已解决]请教VBA多条件汇总的写法

jszjglrf

请教高手关于多条件汇总VBA的写法
最好有人思路说明
便于我这种菜鸟依葫芦画葫芦地学习一下

最佳答案

月排行榜 / 总排行榜

liuguansky

2014-9-11 09:19

1. 
   

复制代码

Sub JustTest()
    Dim d As New Dictionary, I&, lngR&, j&, lngC&
    Dim Arr, Ar&(1 To 10, 1 To 11)
    With Sheet2
        Arr = .[c2:m2]
        For I = 1 To UBound(Arr, 2)
            d.Add Arr(1, I), I
        Next I
        Arr = .[b4:b8]
        For I = 1 To UBound(Arr)
            d.Add Arr(I, 1) & "R", I
        Next I
    End With
    With Sheet1
        Arr = .Range("b2:g" & .Cells(.Rows.Count, 2).End(3).Row).Value
    End With
    For I = 1 To UBound(Arr)
        lngR = IIf(Arr(I, 6) = "Æóòμ", 0, 5) + d(Left(Arr(I, 5), 2) & "R")
        For j = 2 To 4
            lngC = d(Arr(I, j))
            Ar(lngR, lngC) = Ar(lngR, lngC) + Arr(I, 1)
        Next j
    Next I
    With Sheet2
        With .[c4:m13]
            .ClearContents
            .Value = Ar
        End With
    End With
    Set d = Nothing
End Sub


看下合你要求不？

跳转到最佳答案楼层

zjdh

看不懂你的要求！
你就不会做一个结果范例？

jszjglrf

用VBA多条件求和

dsmch

jszjglrf 发表于 2014-2-22 14:53
用VBA多条件求和

表二的四级分类怎么和A、B列对应？表格设计有问题。

jszjglrf

jszjglrf 发表于 2014-2-22 14:53
用VBA多条件求和

三维表式

liuguansky

正常
关注
次级
可疑
损失
这些类别是如何划分的？

liuguansky

1. 
   

复制代码

Sub JustTest()
    Dim d As New Dictionary, I&, lngR&, j&, lngC&
    Dim Arr, Ar&(1 To 10, 1 To 11)
    With Sheet2
        Arr = .[c2:m2]
        For I = 1 To UBound(Arr, 2)
            d.Add Arr(1, I), I
        Next I
        Arr = .[b4:b8]
        For I = 1 To UBound(Arr)
            d.Add Arr(I, 1) & "R", I
        Next I
    End With
    With Sheet1
        Arr = .Range("b2:g" & .Cells(.Rows.Count, 2).End(3).Row).Value
    End With
    For I = 1 To UBound(Arr)
        lngR = IIf(Arr(I, 6) = "Æóòμ", 0, 5) + d(Left(Arr(I, 5), 2) & "R")
        For j = 2 To 4
            lngC = d(Arr(I, j))
            Ar(lngR, lngC) = Ar(lngR, lngC) + Arr(I, 1)
        Next j
    Next I
    With Sheet2
        With .[c4:m13]
            .ClearContents
            .Value = Ar
        End With
    End With
    Set d = Nothing
End Sub


看下合你要求不？