一个对我来说比较复杂的数据汇总问题,请求解决

zsueducn

附件是一个希望可以实现条件筛选,动态显示的数据汇总问题.希望可以得到老师们的帮助.

zsueducn

用高级筛选实现起来,会有很多不想显示东西出来,排版起来也不方便,因为我希望得到这段代码后再作修改,有其它用途的.

zsueducn

如果这样实现起来不方便,也可以加一个按钮.求代码解决..

www.36600.net

你没考虑过用数据透视表吗?用在你这个问题上应该比宏方便

zhaogang1960

请测试：
test7878.rar (12.97 KB, 下载次数: 34)

2009-7-4 23:15 上传

点击文件名下载附件

www.36600.net

看看我这个这数据透视表做的,希望能符合你的要求

zsueducn

数据透视表,我知道很方便,但局限太多了,我修改起来不方便,可能是我技术还不到家.

谢谢  zhaogang1960   我下载了你给我的代码.在测试.

zsueducn

zhaogang1960  看了代码,有点跟不上思路,能帮我注释一下.谢谢

Sub Macro1()
    Dim arr, brr(), d As Object, dic As Object, i As Long, j As Integer, m As Integer
    arr = Range("L2:O" & Range("IV2").End(xlToLeft).Column)
    Set d = CreateObject("Scripting.Dictionary")
    For j = 3 To UBound(arr, 2)
        d(arr(1, 1) & arr(1, j)) = ""
    Next
    arr = Range("A2:I" & Range("A65536").End(xlUp).Row)
    Set dic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(arr)
        If d.exists(arr(i, 1) & arr(i, 2)) Then
            If dic(arr(i, 1) & arr(i, 3) & arr(i, 4)) = "" Then
                m = m + 1
                dic(arr(i, 1) & arr(i, 3) & arr(i, 4)) = m
                ReDim Preserve brr(1 To 4, 1 To m)
                For j = 2 To 4
                    brr(j - 1, m) = arr(i, j)
                Next
                brr(4, m) = arr(i, 9)
            Else
                brr(4, dic(arr(i, 1) & arr(i, 3) & arr(i, 4))) = brr(4, dic(arr(i, 1) & arr(i, 3) & arr(i, 4))) + arr(i, 9)
            End If
        End If
    Next
    If m > 0 Then
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        Range("K4:N" & Range("l65536").End(xlUp).Row + 1).Clear
        With [k4].Resize(m, 4)
            .Value = WorksheetFunction.Transpose(brr)
'            .Sort Key1:=Range("K4").Resize(m)'如果颜色列出现不连续，启用这一句
            .Borders.LineStyle = xlContinuous
        End With
        arr = Range("K4").Resize(m)
        For i = 2 To UBound(arr)
            If arr(i, 1) = arr(i - 1, 1) Then Cells(i + 2, 11).Resize(2).Merge
        Next
        Application.DisplayAlerts = True
        Application.ScreenUpdating = True
    End If

End Sub

zhaogang1960

注释如下：
Sub Macro1()
    Dim arr, brr(), d As Object, dic As Object, i As Long, j As Integer, m As Integer
    arr = Range("L2:O" & Range("IV2").End(xlToLeft).Column) '将筛选条件写入数组
    Set d = CreateObject("Scripting.Dictionary") '使用字典
    For j = 3 To UBound(arr, 2)
        d(arr(1, 1) & arr(1, j)) = "" '将“款号”连接“颜色”添加到字典键值
    Next
    arr = Range("A2:I" & Range("A65536").End(xlUp).Row) '数据区写入数组
    Set dic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(arr) '逐行
        If d.exists(arr(i, 1) & arr(i, 2)) Then '“款号”和“颜色”在汇总范围内
            If dic(arr(i, 1) & arr(i, 3) & arr(i, 4)) = "" Then '字典dic不存在，即：款号、类别、物料名称第一次出现
                m = m + 1 '计数
                dic(arr(i, 1) & arr(i, 3) & arr(i, 4)) = m '计数值添加到字典条目以记录生成汇总结果的行号
                ReDim Preserve brr(1 To 4, 1 To m) '重新定义数字存放汇总结果
                For j = 2 To 4
                    brr(j - 1, m) = arr(i, j) '数据写入数组
                Next
                brr(4, m) = arr(i, 9) '用量
            Else '字典dic已经存在，即：款号、类别、物料名称不是第一次出现，“用量”和前面记录的累加
                brr(4, dic(arr(i, 1) & arr(i, 3) & arr(i, 4))) = brr(4, dic(arr(i, 1) & arr(i, 3) & arr(i, 4))) + arr(i, 9)
            End If
        End If
    Next
    If m > 0 Then '有符合条件的
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        Range("K4:N" & Range("l65536").End(xlUp).Row + 1).Clear '清除汇总区
        With [k4].Resize(m, 4) '汇总区
            .Value = WorksheetFunction.Transpose(brr) '写数据
'            .Sort Key1:=Range("K4").Resize(m)'排序，如果颜色列出现不连续，启用这一句
            .Borders.LineStyle = xlContinuous '加边框
        End With
        arr = Range("K4").Resize(m) 'k列数据区写入数组
        For i = 2 To UBound(arr) '上下颜色相同的单元格合并
            If arr(i, 1) = arr(i - 1, 1) Then Cells(i + 2, 11).Resize(2).Merge
        Next
        Application.DisplayAlerts = True
        Application.ScreenUpdating = True
    End If
End Sub

zsueducn

真的很感谢  zhaogang1960  不过,我从来没有用过数组来写代码,我还是看不懂啊..

能帮我再作小小改动吗?就是把类别那一列也进行一个动态的单元格合并.