非常典型的双条件汇总

张雄友

非常典型的双条件汇总。

EH2003

你的代码存在一个小Bug，如果被汇总的有一个空行就出错。
这是我修改后的代码
Sub 双条件求和1()
    Dim d As Object
    Dim arr As Variant
    Dim i As Long
    Dim j As Long
    Dim m As Long
    Dim r, r1
    Set d = CreateObject("Scripting.Dictionary")
    r1 = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
     arr = Sheet1.Range("A2:c" & r1)
    For i = 2 To UBound(arr)
    '    If IsNumeric(arr(i, 3)) Then
            r = d(arr(i, 1) & arr(i, 2))
            If r = "" Then
                m = m + 1
                d(arr(i, 1) & arr(i, 2)) = m 'm=r
                For j = 1 To 3
                   arr(m, j) = arr(i, j)
                Next
            Else
               arr(r, 3) = arr(r, 3) + arr(i, 3)
            End If
       ' End If
    Next
    With Sheet2
        .[A1].CurrentRegion.Offset(1).ClearContents
        .[A2].Resize(m, 3) = arr
        .Activate
    End With
End Sub

张雄友

EH2003 发表于 2015-10-25 22:03
你的代码存在一个小Bug，如果被汇总的有一个空行就出错。
这是我修改后的代码
Sub 双条件求和1()

这是因为：arr = Range("A1").CurrentRegion 不对后续数据是否为数组作出判断。
你用：r1 = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
     arr = Sheet1.Range("A2:c" & r1)
对数据不规范也做了考虑，arr = Range("A1").CurrentRegion 是建立在数据规范的前提下的。

EH2003

张雄友 发表于 2015-10-25 22:15
这是因为：arr = Range("A1").CurrentRegion 不对后续数据是否为数组作出判断。
你用：r1 = Sheet1.Cell ...

作为典型应用，要考虑到非规范性的数据。

张雄友

EH2003 发表于 2015-10-25 22:21
作为典型应用，要考虑到非规范性的数据。

arr = Sheet1.Range("A2:c" & r1)
明显错了，应为：arr = Sheet1.Range("A1:c" & r1)

xieyidh

哈哈,这个正是我需要的,但帮我修改一下,现在只在第3列汇总,我需要第3至7列数据都要汇总,第8列也进行横汇总,因为代码我看不明白,麻烦大侠代劳了,谢谢.

xieyidh

各位大侠都不这来帮我一下,我需要的格式对我很重要,谢谢了.

一休和尚

这是双条件汇总只有C列的数据，如果后面列都有数据呢？
如果要三条件汇总呢？
考虑到通用性的话，还是需要编制全面一些；
而且做好能在代码后面注释一下；
这样大家学习起来就方便了；
感谢大师分享！

xieyidh

就这样给沉没了?

张雄友

xieyidh 发表于 2015-10-30 11:26
就这样给沉没了?

附件都没，你给我一百万我也没办法收。