根据特定条件合并 Excel 中的行

Question

我一整天都在想这件事。基本上我们有一个超过 500,000 条记录的 Excel 表，其中包含需要合并到一行中的信息/行，以便能够将其导入我们的会计软件。

TRNS    48150   BILL    1/13/2012   11-000-150300-A         23.62    
SPL    48150    BILL    1/13/2012   11-000-150300-A        286.26    
SPL    48150    BILL    1/13/2012   20-000-010000-A        -23.62       
SPL    48150    BILL    1/13/2012   20-000-010000-A       -286.26

帐号为 20-000-01000-A 的所有记录必须在每个 TRNSID 的一行中汇总。我需要它看起来像：

TRNS    48150   BILL    1/13/2012   11-000-150300-A         23.62
SPL     48150   BILL    1/13/2012   11-000-150300-A        286.26
SPL     48150   BILL    1/13/2012   20-000-010000-A       -309.88

当然，我确实尽了最大努力，但没有结果。我不是一个 VBA 程序员，所以我将它导入 Access 以尝试运行查询以使其工作，但它没有。我也试过这个，但一直出错。我将不胜感激。

Sub fun()

    Worksheets("Sheet1").Activate
    If Range("E:E").Value = "20-000-01000-A" Then
    Selection.Subtotal GroupBy:=5, Function:=xlSum, TotalList:=Array(8)

结束子

TRNS    48150   BILL    1/13/2012   11-000-150300-A         23.62    
SPL    48150    BILL    1/13/2012   11-000-150300-A        286.26    
SPL    48150    BILL    1/13/2012   20-000-010000-A        -23.62       
SPL    48150    BILL    1/13/2012   20-000-010000-A       -286.26
ENDTRNS
TRNS    48151   BILL    1/13/2012   11-000-150300-A          1.87 
SPL    48151    BILL    1/13/2012   11-000-150300-A         14.65
SPL    48151    BILL    1/13/2012   11-000-150300-A          8.06
SPL    48151    BILL    1/13/2012   20-000-010000-A        - 1.87    
SPL    48151    BILL    1/13/2012   20-000-010000-A        -14.65       
SPL    48151    BILL    1/13/2012   20-000-010000-A         -8.06
ENDTRNS

---

这是我需要的结果。仅将具有 20-000-01000-A 的行合并为一行。

TRNS    48150   BILL    1/13/2012   11-000-150300-A         23.62    
SPL    48150    BILL    1/13/2012   11-000-150300-A        286.26    
SPL    48150    BILL    1/13/2012   20-000-010000-A       -309.88       
ENDTRNS
TRNS    48151   BILL    1/13/2012   11-000-150300-A          1.87 
SPL    48151    BILL    1/13/2012   11-000-150300-A         14.65
SPL    48151    BILL    1/13/2012   11-000-150300-A          8.06    
SPL    48151    BILL    1/13/2012   20-000-010000-A        -24.58       
ENDTRNS

Answer 1

你可以不使用宏来尝试一些东西。

首先将前 5 列复制到另一个工作表，然后使用 RemoveDuplicates（数据菜单）。 那你就可以=SUMIFS(Sheet1!F:F, Sheet1!A:A, RC1, Sheet2!B:B, RC2, Sheet2!C:C, RC3, Sheet2!D:D, RC4, Sheet2!E:E, RC5)

我期待这样的列：

 A     B    C      D              E        F
TRNS 48150 BILL 1/13/2012 11-000-150300-A 23.62

编辑：

您也可以使用数据透视表。

** 编辑2：** 对不起，伙计，我没有太多时间为你做一个漂亮的代码和所有的验证。我正在删除行，使用标志等等（您可以在代码中做的所有最糟糕的事情），但它符合目的。 :-)

Sub MakahHelper()
    Dim lastRow As Integer, matches() As Double, i As Double, total As Double

    lastRow = Columns(1).SpecialCells(xlCellTypeLastCell).Row
    matches = MatchAll("ENDTRNS", Range(Cells(1, 1), Cells(lastRow, 1)))

    For i = UBound(matches) To 1 Step -1
        'Get the blocks that ends in ENDTRNS.
        firstRow = IIf(i = 1, 1, matches(i - 1) + 1)
        lastRow = matches(i) - 1
        Set theRange = Range(Cells(firstRow, 1), Cells(lastRow, 6))

        'Order
        With ActiveSheet
            .Sort.SortFields.Clear
            .Sort.SortFields.Add Key:=theRange.Columns(5), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            With .Sort
                .SetRange theRange
                .Header = xlNo
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
        End With

        total = 0
        firstOccurrence = False
        'Find the lastRowCons ocurrence of "20-000-010000-A"
        For j = lastRow To firstRow Step -1
            If Cells(j, 5) = "20-000-010000-A" Then
                total = total + Cells(j, 6)

                'Use the first row to consolidate the values (workarround, i'm lazy)
                If Not firstOccurrence Then
                    firstOccurrence = True
                Else
                    Rows(j).Delete
                    lastRow = lastRow - 1
                End If
            End If
        Next

        'Add the value to the first Entry of "20-000-010000-A"
        If firstOccurrence Then
            rowIndex = WorksheetFunction.Match("20-000-010000-A", Range(Cells(firstRow, 5), Cells(lastRow, 5)), 0)
            Cells(firstRow + rowIndex - 1, 6) = total
        End If
    Next
End Sub


Public Function MatchAll(ByVal value As String, ByVal theRange As Range) As Double()
    Dim index As Long, rFoundCell As Range, total As Integer, results() As Double

    total = WorksheetFunction.CountIf(theRange, value)
    If total = 0 Then
        Exit Function
    End If
    ReDim results(total)

    Set rFoundCell = theRange.Cells(1, 1)
    For index = 1 To total

        Set rFoundCell = theRange.Find(What:=value, After:=rFoundCell, _
                LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, MatchCase:=False)

        results(index) = rFoundCell.Row
    Next index

    MatchAll = results
End Function