[已解决]多条件数据汇总求和

lgzxmlg

多条件数据汇总求和 II4OprwY.zip (27.02 KB, 下载次数: 240)

2010-12-19 19:26 上传

点击文件名下载附件
多条件数据汇总求和

最佳答案

月排行榜 / 总排行榜

wxyqxxz2007

2010-12-19 23:19

Sub yyy()
    Dim ar, r, k, i, arr()
    Dim d As Object
    Set d = CreateObject("scripting.dictionary")
    r = Sheets("数据").Range("a65536").End(xlUp).Row
    ar = Sheets("数据").Range("a2:g" & r)
    ReDim arr(1 To UBound(ar), 1 To 23)
    For i = 1 To UBound(ar)
        Select Case ar(i, 7)
        Case Is <= 30
            k = 1
        Case 30 To 70
            k = 5
        Case 70 To 100
            k = 9
        Case Is > 100
            k = 13
        End Select
        If Not d.exists(ar(i, 3)) Then
            h = h + 1
            d(ar(i, 3)) = h
            arr(h, 1) = ar(i, 3)
        End If
        Select Case ar(i, 1)
        Case Is = "1#"
            m = 1
            If arr(d(ar(i, 3)), 18) < ar(i, 7) Then arr(d(ar(i, 3)), 18) = ar(i, 7)
            If arr(d(ar(i, 3)), 21) > ar(i, 7) Or arr(d(ar(i, 3)), 21) = 0 Then arr(d(ar(i, 3)), 21) = ar(i, 7)
        Case Is = "5#"
            m = 2
            If arr(d(ar(i, 3)), 19) < ar(i, 7) Then arr(d(ar(i, 3)), 19) = ar(i, 7)
            If arr(d(ar(i, 3)), 22) > ar(i, 7) Or arr(d(ar(i, 3)), 22) = 0 Then arr(d(ar(i, 3)), 22) = ar(i, 7)
        Case Is = "6#"
            m = 3
            If arr(d(ar(i, 3)), 20) < ar(i, 7) Then arr(d(ar(i, 3)), 20) = ar(i, 7)
            If arr(d(ar(i, 3)), 23) > ar(i, 7) Or arr(d(ar(i, 3)), 23) = 0 Then arr(d(ar(i, 3)), 23) = ar(i, 7)
        End Select
        arr(d(ar(i, 3)), k + m) = arr(d(ar(i, 3)), k + m) + ar(i, 5)
        arr(d(ar(i, 3)), k + 4) = arr(d(ar(i, 3)), k + 4) + ar(i, 5)
    Next
    Sheets("统计").Range("a4").Resize(h, 23) = arr
End Sub

跳转到最佳答案楼层

那么的帅

请具体解释条件和汇总的内容

<=30 等什么意思？

A列未发现炉号为1#的

汇总的内容是数据表的哪一列

lgzxmlg

1、依据“数据”中A列的炉号和G列中的含量进行分类统计汇总到“统计”表中。
2、汇总条件为：A列的炉号："可能有1#、5#、6#",G列的含量：含量范围分为0-30（包括30）、30-70（包括70）、70-100（包括100）、大于100

3、最大、最小为G列含量的最大和最小值。
3、用VBA做。

不知道说明白了没？？

青城山苦丁茶

试试看行不：

Sub test()
Dim arr1(), arr2(1 To 30, 1 To 22)
Dim i1%, I2%, I3%
With Sheets("数据")
   arr1 = .Range("a2:g" & .[a65536].End(xlUp).Row).Value
End With
For i1 = 1 To UBound(arr1)
   If arr1(i1, 7) <= 30 Then
      I2 = 1
   ElseIf arr1(i1, 7) <= 70 Then
      I2 = 5
   ElseIf arr1(i1, 7) <= 100 Then
      I2 = 9
   Else
      I2 = 13
   End If
   If arr1(i1, 1) = "1#" Then
      arr2(Day(arr1(i1, 3)), I2) = arr2(Day(arr1(i1, 3)), I2) + arr1(i1, 7)
      If arr2(Day(arr1(i1, 3)), 17) < arr1(i1, 7) Then arr2(Day(arr1(i1, 3)), 17) = arr1(i1, 7)
      If arr2(Day(arr1(i1, 3)), 20) = 0 Or arr2(Day(arr1(i1, 3)), 20) > arr1(i1, 7) Then arr2(Day(arr1(i1, 3)), 20) = arr1(i1, 7)
   ElseIf arr1(i1, 1) = "5#" Then
      arr2(Day(arr1(i1, 3)), I2 + 1) = arr2(Day(arr1(i1, 3)), I2 + 1) + arr1(i1, 7)
      If arr2(Day(arr1(i1, 3)), 18) < arr1(i1, 7) Then arr2(Day(arr1(i1, 3)), 18) = arr1(i1, 7)
      If arr2(Day(arr1(i1, 3)), 21) = 0 Or arr2(Day(arr1(i1, 3)), 21) > arr1(i1, 7) Then arr2(Day(arr1(i1, 3)), 21) = arr1(i1, 7)
   Else
      arr2(Day(arr1(i1, 3)), I2 + 2) = arr2(Day(arr1(i1, 3)), I2 + 2) + arr1(i1, 7)
      If arr2(Day(arr1(i1, 3)), 19) < arr1(i1, 7) Then arr2(Day(arr1(i1, 3)), 19) = arr1(i1, 7)
      If arr2(Day(arr1(i1, 3)), 22) = 0 Or arr2(Day(arr1(i1, 3)), 22) > arr1(i1, 7) Then arr2(Day(arr1(i1, 3)), 22) = arr1(i1, 7)
   End If
   arr2(Day(arr1(i1, 3)), I2 + 3) = arr2(Day(arr1(i1, 3)), I2 + 3) + arr1(i1, 7)
Next
With Sheets("统计")
   .[b4].Resize(30, 22) = arr2
End With
End Sub

lastmem

用透视表能做一部分，用SUMPRODUCT（）也可能做出来，用VBA我不会。。

lgzxmlg

用代码试了下，数据统计不全，不知什么原因

wxyqxxz2007

Sub yyy()
    Dim ar, r, k, i, arr()
    Dim d As Object
    Set d = CreateObject("scripting.dictionary")
    r = Sheets("数据").Range("a65536").End(xlUp).Row
    ar = Sheets("数据").Range("a2:g" & r)
    ReDim arr(1 To UBound(ar), 1 To 23)
    For i = 1 To UBound(ar)
        Select Case ar(i, 7)
        Case Is <= 30
            k = 1
        Case 30 To 70
            k = 5
        Case 70 To 100
            k = 9
        Case Is > 100
            k = 13
        End Select
        If Not d.exists(ar(i, 3)) Then
            h = h + 1
            d(ar(i, 3)) = h
            arr(h, 1) = ar(i, 3)
        End If
        Select Case ar(i, 1)
        Case Is = "1#"
            m = 1
            If arr(d(ar(i, 3)), 18) < ar(i, 7) Then arr(d(ar(i, 3)), 18) = ar(i, 7)
            If arr(d(ar(i, 3)), 21) > ar(i, 7) Or arr(d(ar(i, 3)), 21) = 0 Then arr(d(ar(i, 3)), 21) = ar(i, 7)
        Case Is = "5#"
            m = 2
            If arr(d(ar(i, 3)), 19) < ar(i, 7) Then arr(d(ar(i, 3)), 19) = ar(i, 7)
            If arr(d(ar(i, 3)), 22) > ar(i, 7) Or arr(d(ar(i, 3)), 22) = 0 Then arr(d(ar(i, 3)), 22) = ar(i, 7)
        Case Is = "6#"
            m = 3
            If arr(d(ar(i, 3)), 20) < ar(i, 7) Then arr(d(ar(i, 3)), 20) = ar(i, 7)
            If arr(d(ar(i, 3)), 23) > ar(i, 7) Or arr(d(ar(i, 3)), 23) = 0 Then arr(d(ar(i, 3)), 23) = ar(i, 7)
        End Select
        arr(d(ar(i, 3)), k + m) = arr(d(ar(i, 3)), k + m) + ar(i, 5)
        arr(d(ar(i, 3)), k + 4) = arr(d(ar(i, 3)), k + 4) + ar(i, 5)
    Next
    Sheets("统计").Range("a4").Resize(h, 23) = arr
End Sub

lgzxmlg

Sub test()
Dim arr1(), arr2(1 To 30, 1 To 22)
Dim i1%, I2%, I3%
With Sheets("数据")
   arr1 = .Range("a2:g" & .[a65536].End(xlUp).Row).Value
End With
For i1 = 1 To UBound(arr1)
   If arr1(i1, 7) <= 30 Then
      I2 = 1
   ElseIf arr1(i1, 7) <= 70 Then
      I2 = 5
   ElseIf arr1(i1, 7) <= 100 Then
      I2 = 9
   Else
      I2 = 13
   End If
   If arr1(i1, 1) = "1#" Then
      arr2(Day(arr1(i1, 3)), I2) = arr2(Day(arr1(i1, 3)), I2) + arr1(i1, 7)
      If arr2(Day(arr1(i1, 3)), 17) < arr1(i1, 7) Then arr2(Day(arr1(i1, 3)), 17) = arr1(i1, 7)
      If arr2(Day(arr1(i1, 3)), 20) = 0 Or arr2(Day(arr1(i1, 3)), 20) > arr1(i1, 7) Then arr2(Day(arr1(i1, 3)), 20) = arr1(i1, 7)
   ElseIf arr1(i1, 1) = "5#" Then
      arr2(Day(arr1(i1, 3)), I2 + 1) = arr2(Day(arr1(i1, 3)), I2 + 1) + arr1(i1, 7)
      If arr2(Day(arr1(i1, 3)), 18) < arr1(i1, 7) Then arr2(Day(arr1(i1, 3)), 18) = arr1(i1, 7)
      If arr2(Day(arr1(i1, 3)), 21) = 0 Or arr2(Day(arr1(i1, 3)), 21) > arr1(i1, 7) Then arr2(Day(arr1(i1, 3)), 21) = arr1(i1, 7)
   Else
      arr2(Day(arr1(i1, 3)), I2 + 2) = arr2(Day(arr1(i1, 3)), I2 + 2) + arr1(i1, 7)
      If arr2(Day(arr1(i1, 3)), 19) < arr1(i1, 7) Then arr2(Day(arr1(i1, 3)), 19) = arr1(i1, 7)
      If arr2(Day(arr1(i1, 3)), 22) = 0 Or arr2(Day(arr1(i1, 3)), 22) > arr1(i1, 7) Then arr2(Day(arr1(i1, 3)), 22) = arr1(i1, 7)
   End If
   arr2(Day(arr1(i1, 3)), I2 + 3) = arr2(Day(arr1(i1, 3)), I2 + 3) + arr1(i1, 7)
Next
With Sheets("统计")
   .[b4].Resize(30, 22) = arr2
End With
End Sub

代码看不太懂，试将上面的“7”改为“5”结果对了，谢谢青城山苦丁茶[em24]