VBA多条件的统计数量汇总

jnsday

原本 我用SUMPRODUCT的公式来做，然后我发现，再牛的电脑都会卡成狗~~=SUMPRODUCT((Sheet4!$B:B=A2)*(Sheet4!$C:C=B2)*(Sheet4!$H:H=C2)+(Sheet4!B:B=A2)*(Sheet4!$C:C=B2)*(Sheet4!$H:H=D2))
有没有什么办法，条件统计 表Sheet4中的 型号&容量&运营商（判定一次背景色需要为无背景色），然后自动统计出数据到另外的表里

jnsday

好吧。。貌似都没人。。哎  

zax010

Sub zz()
    Dim d, ar, sh As Worksheet
    Set d = CreateObject("Scripting.Dictionary")
    d.CompareMode = vbTextCompare
    Application.ScreenUpdating = False
    ar = Sheet2.Range("A1").CurrentRegion
    For i = 2 To UBound(ar)
        If ar(i, 8) <> "" Then d(ar(i, 2) & ar(i, 3) & ar(i, 8)) = d(ar(i, 2) & ar(i, 3) & ar(i, 8)) + 1
    Next
    For Each sh In Sheets
        If sh.Name <> "Sheet4" Then
            With sh
                For i = 2 To .[a65536].End(3).Row
                    s1 = .Cells(i, 1) & .Cells(i, 2) & .Cells(i, 3)
                    s2 = .Cells(i, 1) & .Cells(i, 2) & .Cells(i, 4)
                    .Cells(i, 5) = d(s1) + d(s2)
                Next
            End With
        End If
    Next
    Application.ScreenUpdating = True
End Sub

zax010

>>>>>>>>>>>>>>>>>>>>>>




模板.rar (39.7 KB, 下载次数: 234)

2017-3-25 22:55 上传

点击文件名下载附件

jnsday

zax010 发表于 2017-3-25 23:01
>>>>>>>>>>>>>>>>>>>>>>

万分感谢~~
大部分功能都实现了~~
我略微的做了一些适应性修改，另外我试图按照你之前的帖子，添加判断 Sheet2.A1 底色是否为未填充，最后失败了
你的源码：
If Cells(i, j).Interior.ColorIndex <> 6 Then
参照修改失败：
If ar(i, 8).Interior.ColorIndex = "0" Then d(ar(i, 2) & ar(i, 3) & ar(i, 8)) = d(ar(i, 2) & ar(i, 3) & ar(i, 8)) + 1
提示没有对象，是不能直接这么上么。。
期待你的回复



Sub zz()
    Dim d, ar, sh As Worksheet
    Set d = CreateObject("Scripting.Dictionary")
    d.CompareMode = vbTextCompare
    ar = Sheet2.Range("A1").CurrentRegion
    For i = 2 To UBound(ar)
        ar(i, 2) = Replace(ar(i, 2), "  ", " ")
      
         d(ar(i, 2) & ar(i, 3) & ar(i, 8)) = d(ar(i, 2) & ar(i, 3) & ar(i, 8)) + 1

    Next
    sa = d.items
    For Each sh In Sheets
        If sh.Name <> "原始数据" Then
            With sh           
                For i = 2 To .[a65536].End(3).Row
                 If .Cells(i, 3) <> "" Or .Cells(i, 4) <> "" Then
                    s1 = .Cells(i, 1) & .Cells(i, 2) & .Cells(i, 3)
                    s2 = .Cells(i, 1) & .Cells(i, 2) & .Cells(i, 4)
                     .Cells(i, 5) = ""
                    .Cells(i, 5) = d(s1) + d(s2)
                    Else
                    s1 = .Cells(i, 1) & .Cells(i, 2)
                     .Cells(i, 5) = ""
                    .Cells(i, 5) = d(s1) + 0
                     End If
                                          
                Next

               
               
            End With
        End If
    Next
End Sub

zax010

jnsday 发表于 2017-3-26 11:52
万分感谢~~
大部分功能都实现了~~
我略微的做了一些适应性修改，另外我试图按照你之前的帖子，添加判断 ...

If ar(i, 8).Interior.ColorIndex = "0"   Then

不知你要干什么，但上面写法肯定不对，应为

If ar(i, 8).Interior.ColorIndex = 0   Then

jnsday

zax010 发表于 2017-3-26 12:18
If ar(i, 8).Interior.ColorIndex = "0"   Then

不知你要干什么，但上面写法肯定不对，应为

就是想统计，B列，不带底色的数据，带底色的跳过，不加入数组
添加这个之后，报错424，要求对象
If ar(i, 8).Interior.ColorIndex = 0   Then

lsc900707

jnsday 发表于 2017-3-26 11:52
万分感谢~~
大部分功能都实现了~~
我略微的做了一些适应性修改，另外我试图按照你之前的帖子，添加判断 ...

If ar(i, 8).Interior.ColorIndex = "0"
没有这样的写法，改成：
If ar(i, 8).Interior.ColorIndex = 0

zax010

jnsday 发表于 2017-3-26 12:36
就是想统计，B列，不带底色的数据，带底色的跳过，不加入数组
添加这个之后，报错424，要求对象
If ar ...

连我都整迷了，应该是

If Sheet2.Cells(i, 8).Interior.ColorIndex = 0   Then

zax010

jnsday 发表于 2017-3-26 12:36
就是想统计，B列，不带底色的数据，带底色的跳过，不加入数组
添加这个之后，报错424，要求对象
If ar ...

看完新传附件，才知又没搞对，再试：

        If ar(i, 8) <> "" And Sheet2.Cells(i, 8).Interior.ColorIndex = xlNone Then d(ar(i, 2) & ar(i, 3) & ar(i, 8)) = d(ar(i, 2) & ar(i, 3) & ar(i, 8)) + 1