[已解决]工作薄内的数据多条件汇总

安全网

fjmxwrs 发表于 2016-5-26 22:27
你最好把完整的东西传上来，当然数据可以替代了，主要是表格的样式不能变，这代码并不通用，

把工作表1的4个条件都写入汇总内

安全网

fjmxwrs 发表于 2016-5-26 22:27
你最好把完整的东西传上来，当然数据可以替代了，主要是表格的样式不能变，这代码并不通用，

Sub test()
    Dim d As Object, str1$
    Dim arr, brr()
    Dim x%, y%, i%
    Set d = CreateObject("scripting.dictionary")
    arr = Sheet1.Range("A2").CurrentRegion
    For x = 2 To UBound(arr)
        str1 = arr(x, 2) & arr(x, 3) & arr(x, 4) & arr(x, 5)
        If Not d.exists(str1) Then
            i = i + 1
            d(str1) = i
            ReDim Preserve brr(1 To 13, 1 To i)
            brr(1, i) = i
            brr(2, i) = arr(x, 2)
            brr(3, i) = arr(x, 3)
            brr(4, i) = arr(x, 4)
            brr(5, i) = arr(x, 5)
        End If
        For y = 6 To UBound(arr, 2)
            brr(y - 1, d(str1)) = brr(y - 1, d(str1)) + arr(x, y)
        Next y
    Next x
    With Sheet2
        .Range("A3:M200").ClearContents
        .Range("A3:M200").Borders.LineStyle = 0
        .Range("A3").Resize(UBound(brr, 2), 13) = Application.Transpose(brr)
        .Range("A3").Resize(UBound(brr, 2), 13).Borders.LineStyle = 1
    End With
    Erase arr, brr
    d.RemoveAll
End Sub

这样改为什么最后一列数据不能统计到里面去了

fjmxwrs

安全网 发表于 2016-5-27 13:14
Sub test()
    Dim d As Object, str1$
    Dim arr, brr()

1. For y = 6 To UBound(arr, 2)
   
2.             brr(y, d(str1)) = brr(y, d(str1)) + arr(x, y)
   
3.         Next y

复制代码

这句不用y-1

安全网

fjmxwrs 发表于 2016-5-27 19:26
这句不用y-1

能否在书数据最下面一行和数据列最后一列增加汇总栏了

fjmxwrs

安全网 发表于 2016-5-30 17:10
能否在书数据最下面一行和数据列最后一列增加汇总栏了

可以的