vba自动分类汇总

霜雪GILL

图1为原始数据即表SHEET1,请用VBA实现图2即SHEET2的效果(把SHEET1表的原始数据自动分类汇总到SHEET2表中)谢谢!

不知道为什么

看不明白你的逻辑

霜雪GILL

不知道为什么 发表于 2018-7-26 21:09
看不明白你的逻辑

a1的图是原始数据,然后用VBA自动分类汇总成a2图

xiaoqiang17

图片与文件不一样的？

不知道为什么

霜雪GILL 发表于 2018-7-26 22:20
a1的图是原始数据,然后用VBA自动分类汇总成a2图

都送小花了，那必须得给做出来了啊，我就猜题做了

xiaoqiang17

试做，供参考。

逍遥之浪子

说明：你先在销售明细所在的工作簿中新建一张名叫汇总的工作表，然后将代码复制运行

Sub 汇总()
Dim i, j, a, b, z, k, p, o, m, g, h, d, dd, az As Integer
k = 2
    For i = 2 To Sheets("销售明细").Cells(Rows.Count, 6).End(xlUp).Row
        For j = 1 To b + 1
            If Sheets("销售明细").Cells(i, 6) = Sheets("汇总").Cells(j, 11) Then
               a = a + 1
            End If
        Next
        If a = 0 Then
            b = b + 1
            Sheets("汇总").Cells(b, 11) = Sheets("销售明细").Cells(i, 6)
        End If
        a = 0
    Next
    Sheets("汇总").Range("a1:f1").Merge
    Sheets("汇总").Cells(1, 1) = "客户月销明细表"
    Sheets("汇总").Cells(1, 1).HorizontalAlignment = xlCenter
    Sheets("销售明细").Range("D1:J1").Copy Sheets("汇总").Range("A2")
    For p = 1 To Sheets("汇总").Cells(Rows.Count, 11).End(xlUp).Row
        For o = 2 To Sheets("销售明细").Cells(Rows.Count, 6).End(xlUp).Row
            If Sheets("汇总").Cells(p, 11) = Sheets("销售明细").Cells(o, 6) Then
                m = m + 1
            End If
        Next
        Sheets("汇总").Cells(p, 12) = m
        m = 0
    Next
    For g = 1 To Sheets("汇总").Cells(Rows.Count, 11).End(xlUp).Row
        d = d + 1
        For h = 1 To Sheets("销售明细").Cells(Rows.Count, 6).End(xlUp).Row
            If Sheets("汇总").Cells(g, 11) = Sheets("销售明细").Cells(h, 6) Then
                k = k + 1
                Sheets("销售明细").Range("d" & h & ":" & "j" & h).Copy Sheets("汇总").Range("A" & k)
            End If
        Next
        k = k + 1
        Sheets("汇总").Cells(k, 3) = "小计"
        dd = Sheets("汇总").Cells(d, 12)
        Sheets("汇总").Cells(k, 7) = Application.WorksheetFunction.Sum(Range(Sheets("汇总").Cells(k - dd, 7), Sheets("汇总").Cells(k - 1, 7)))
    Next
   Sheets("汇总").Range("b:b,k:l").Delete
   az = Sheets("汇总").Cells(Rows.Count, 2).End(xlUp).Row
   Sheets("汇总").Range("a2:a" & az).Copy Range("h2")
   Sheets("汇总").Range("b2:b" & az).Copy Range("a2")
   Sheets("汇总").Range("h2:h" & az).Copy Range("b2")
   Sheets("汇总").Range("h2:h" & az).Delete
End Sub

逍遥之浪子

mikezhan 发表于 2018-7-27 08:23
兄弟，你这思路再回去修炼几年。。。。。。。。。。

有数组不用？ 有字典不用？ 直接对表格对象的操作 ...

最基本的能解决就可以