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

我一整天都在为此而头痛。 基本上我们有一个500,000+的loggingexcel表,有信息/行需要合并成一行,以便能够将其导入到我们的会计软件。

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的logging必须每个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 

你可以尝试一些东西,而不使用macros。

首先,将前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)

我期待这样的列:

  ABCDEF TRNS 48150 BILL 1/13/2012 11-000-150300-A 23.62 

编辑:

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

**编辑2:**对不起,我没有太多的时间为你做所有的validation美丽的代码。 我正在删除行,使用标志等(在代码中可以做的所有最糟糕的事情),但它符合目的。 🙂

 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