0

我正在尝试使用 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 崩溃,而实际上没有合并任何东西。

有人对我如何调整此代码以达到我需要的合并解决方案有任何建议吗?

4

2 回答 2

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
于 2013-03-07T12:56:45.943 回答
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
于 2013-03-07T12:45:50.587 回答