我一整天都在打破这个问题。基本上我们有一个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
答案 0 :(得分：0)
您可以在不使用宏的情况下尝试。
首先将前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
修改
您也可以使用数据透视表。
** Edit2：** 对不起，我没有太多时间为你做一个漂亮的代码所有的验证。我正在删除行，使用标志等（你可以在代码中做的所有最糟糕的事情），但它符合目的。 ： - ）
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