目录

示例

数据表

汇总表

代码

---

示例

如图所示，该表为某公司的销售数据。如何使用VBA按商品名汇总销售数量和收入？

数据表

日期	商品代码	商品名	数量	收入
2011/8/17	01.0032	ASWDVBN	0.05	4273.5
2011/1/28	01.0003	ERTGH	1	3589.74
2011/1/29	01.0003	ERTGH	1	3846.15
2011/2/1	01.0004	EFGTYUI	1	13247.86
2011/2/2	01.0004	EFGTYUI	1	16239.32
2011/2/5	01.0007	DFRTYHB	1	1282.05
2011/1/27	01.0003	ERTGH	3	11025.64
2011/4/26	01.0012	ZXSC	3	569.23
2011/4/25	01.0011	RGHUO	8	71794.87
2011/4/24	01.0011	RGHUO	10	85470.09
2011/4/28	01.0014	ASCERT	25	11965.81
2011/5/21	01.0014	ASCERT	25	11858.97
2011/9/11	01.0014	ASCERT	25	11858.97
2011/2/3	01.0005	WERDS	40	153846.2
2011/8/4	01.0028	VGRYUI	40	102564.1
2011/10/18	01.0014	ASCERT	50	23717.95
2011/7/9	01.0014	ASCERT	50	23717.95
2011/1/31	01.0003	ERTGH	60	256410.3
2011/1/30	01.0003	ERTGH	74	316239.3
2011/6/25	01.0014	ASCERT	75	35576.92
2011/2/11	01.0007	DFRTYHB	100	108547
2011/2/12	01.0007	DFRTYHB	100	109401.7
2011/2/23	01.0007	DFRTYHB	100	104273.5
2011/6/6	01.0014	ASCERT	100	47435.9
2011/10/15	01.0014	ASCERT	100	47435.9
2011/10/19	01.0014	ASCERT	100	47435.9
2011/6/24	01.0014	ASCERT	100	47435.9
2011/6/30	01.0014	ASCERT	100	48290.59
2011/11/5	01.0014	ASCERT	150	71153.85
2011/8/15	01.0032	ASWDVBN	150	620897.4
2011/8/16	01.0032	ASWDVBN	150	620897.4

汇总表

商品名	数量合计	收入合计
ASWDVBN	300.05	1246068
ERTGH	139	591111.1
EFGTYUI	2	29487.18
DFRTYHB	17101	18078205
ZXSC	3	569.23
RGHUO	18	157265
ASCERT	35650	16947158
WERDS	40	153846.2

代码

Option Explicit

Sub 按单列汇总数据()
    Dim shtData As Worksheet
    Dim shtSum As Worksheet
    Dim rowSum As Long
    Dim rowData As Long
    Dim Rng As Range
    Dim sKey As String
    
    Set shtData = Sheets("sheet1")
    Set shtSum = Sheets("sheet2")
    
    rowSum = 2
    shtSum.Range("A2:C" & Rows.Count).Clear
    
    '获取汇总列字段不重复记录
    For rowData = 2 To shtData.Range("A1").CurrentRegion.Rows.Count
        sKey = shtData.Cells(rowData, "C").Value
        Set Rng = shtSum.Range("A:A").Find(sKey, lookat:=xlWhole)
        If Rng Is Nothing Then
            shtSum.Cells(rowSum, "A").Value = sKey
            rowSum = rowSum + 1
        End If
    Next rowData
    
    '汇总
    For rowSum = 2 To shtSum.Range("A1").CurrentRegion.Rows.Count
        sKey = shtSum.Cells(rowSum, "A").Value
        For rowData = 2 To shtData.Range("A1").CurrentRegion.Rows.Count
            If shtData.Cells(rowData, "C").Value = sKey Then
                shtSum.Cells(rowSum, "B").Value = shtSum.Cells(rowSum, "B").Value + shtData.Cells(rowData, "D").Value
                shtSum.Cells(rowSum, "C").Value = shtSum.Cells(rowSum, "C").Value + shtData.Cells(rowData, "E").Value
            End If
        Next rowData
    Next rowSum
End Sub