根据B列和排序组

时间:2015-11-26 19:33:52

标签: vba excel-vba excel

根据下面的给定数据,我希望在分配的基础上总计B列,在它下面插入一行,并在2列C和E列中总计其总量。之后我想基于B对该组进行排序日期是G栏。

我尝试了谷歌和其他地方的许多代码但没有工作。请帮助我们使用哪些代码。

   A           B          C          D      E        F     G           H    
1100000014  Expat     -63,126.82    BGN -32,276.23  EUR 07/22/2015  07/17/2015
100009284   Expat     -31,225.08    BGN -31,225.08  BGN 06/19/2015  06/19/2015
100009284   others     11,558.90    BGN  11,558.90  BGN 06/19/2015  06/19/2015
100009339   GLSC          621.96    BGN     318.00  EUR 06/25/2015  06/08/2015
100012975   markeing    10,147.39   BGN  10,147.39  BGN 10/01/2015  09/30/2015

输出应如下所示:

     A         B          C          D      E        F     G           H    

    100009284   Expat     -31,225.08    BGN -31,225.08  BGN 06/19/2015  06/19/2015
1100000014    Expat    -63,126.82   BGN -32,276.23  EUR 07/22/2015  07/17/2015
    Expat Total            xxxxxxx           xxxxxx     
    100009284   others     11,558.90    BGN  11,558.90  BGN 06/19/2015  06/19/2015
    Others Total           xxxxx              xxxxxx         
    100009339   GLSC          621.96    BGN     318.00  EUR 06/25/2015  06/08/2015
    GLSC Total                xxxxx              xxxxxx
    100012975   markeing    10,147.39   BGN  10,147.39  BGN 10/01/2015  09/30/2015
    Marketing Total          xxxxx            xxxxxxx

1 个答案:

答案 0 :(得分:1)

这将创建您在问题中提供的输出,列G按升序排序,与您的示例输出不同,根据您的问题,如果不正确则可以调整VBA。

    Option Explicit
Sub SortAndTotal()
Dim LastRow As Long
Dim ws As Worksheet
Dim r As Long
Dim ColCTotal As Double
Dim ColETotal As Double

    Set ws = ActiveSheet
    LastRow = ws.Cells(100000, 1).End(xlUp).Row

    With ws.Sort.SortFields
        .Clear
        .Add Key:=Range("B1:B" & LastRow)
        .Add Key:=Range("G1:G" & LastRow)
    End With
    With ws.Sort
        .SetRange Range("A1:H" & LastRow)
        .Header = xlNo
        .Apply
    End With

    r = 1
    ColCTotal = 0
    ColETotal = 0
    While ws.Cells(r, 1) <> ""
        ColCTotal = ColCTotal + ws.Cells(r, 3)
        ColETotal = ColETotal + ws.Cells(r, 5)
        If ws.Cells(r, 2) <> ws.Cells(r + 1, 2) Then
            ws.Cells(r + 1, 1).EntireRow.Insert shift:=xlDown
            ws.Cells(r + 1, 1) = ws.Cells(r, 2) & " Total"
            ws.Cells(r + 1, 3) = ColCTotal
            ws.Cells(r + 1, 5) = ColETotal
            ColCTotal = 0
            ColETotal = 0
            r = r + 2
        Else
            r = r + 1
        End If
    Wend
End Sub