我正在尝试使用VBA合并Excel中的重复单元格值。 以下是数据示例:
Col1 Col2
跑1 跑2 见9
去5
见1
我需要合并这些信息,以便数据如下:
Col1 Col2
跑3 见10
去5
意思是,我需要合并第1列中的重复值,并在第2列中对它们的相应值求和。
我已经咨询并尝试了类似的情况:How to SUM / merge similar rows in Excel using VBA?
其中一个建议是以下宏:
Sub Macro1()
Dim ColumnsCount As Integer
ColumnsCount = ActiveSheet.UsedRange.Columns.Count
ActiveSheet.UsedRange.Activate
Do While ActiveCell.Row <= ActiveSheet.UsedRange.Rows.Count
If ActiveCell.Value = ActiveCell.Offset(1, 0).Value Then
For i = 1 To ColumnsCount - 1
ActiveCell.Offset(0, i).Value = ActiveCell.Offset(0, i).Value + ActiveCell.Offset(1, i).Value
Next
ActiveCell.Offset(1, 0).EntireRow.Delete shift:=xlShiftUp
Else
ActiveCell.Offset(1, 0).Select
End If
Loop
End Sub
然而,它似乎正在创建一个无限循环,导致我的excel崩溃,而不实际合并任何东西。
有没有人对如何调整此代码以获得我需要的合并解决方案有任何建议?
答案 0 :(得分:3)
以下假设您的表在单元格A1中开始,而C列以后是空的(如果它们不是,您将丢失合并行上的数据)
Sub mergeCategoryValues()
Dim lngRow As Long
With ActiveSheet
lngRow = .Cells(.LastCell.Row, 1).End(xlUp).Row
.Cells(1).CurrentRegion.Sort key1:=.Cells(1), header:=xlNo 'change this to xlYes if your table has header cells
Do
If .Cells(lngRow - 1, 1) = .Cells(lngRow, 1) Then
.Cells(lngRow - 1, 2) = .Cells(lngRow - 1, 2) + .Cells(lngRow, 2)
.Rows(lngRow).Delete
End If
lngRow = lngRow - 1
Loop Until lngRow < 2
End With
End Sub
答案 1 :(得分:2)
尝试这个(首先排序,然后运行你的代码):
Sub Merge()
Dim ColumnsCount As Integer
Dim i As Integer
Range("A1").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
Do While ActiveCell.Row <= ActiveSheet.UsedRange.Rows.Count
If ActiveCell.Value = ActiveCell.Offset(1, 0).Value Then
For i = 1 To ColumnsCount - 1
ActiveCell.Offset(0, i).Value = ActiveCell.Offset(0, i).Value + ActiveCell.Offset(1, i).Value
Next
ActiveCell.Offset(1, 0).EntireRow.Delete shift:=xlShiftUp
Else
ActiveCell.Offset(1, 0).Select
End If
Loop
End Sub