尝试将代码更改为这个：

Try changing your code to this:

Sub mergeCategoryValues()
    Dim lngRow As Long

    With ActiveSheet
        lngRow = .Cells(65536, 1).End(xlUp).Row
        .Cells(1).CurrentRegion.Sort key1:=.Cells(1), Header:=xlYes

        Do
            If .Cells(lngRow, 1) = .Cells(lngRow - 1, 1) Then
                .Cells(lngRow - 1, 3) = .Cells(lngRow - 1, 3) & "; " & .Cells(lngRow, 3)
                .Cells(lngRow - 1, 4) = .Cells(lngRow - 1, 4) + .Cells(lngRow, 4)
                .Rows(lngRow).Delete
            End If

            lngRow = lngRow - 1
        Loop Until lngRow = 1
    End With
End Sub

测试

Tested

编辑

为了使其更容易调整到不同的列，我在开始时添加了变量来指示哪个列做了什么。请注意，当前逻辑中不使用列2（B）。

To make it a little easier to adjust to different column I added variables at the beginning to indicate which column do what. Note that column 2 (B) isn't used in the current logic.

Sub mergeCategoryValues()
    Dim lngRow As Long

    With ActiveSheet
        Dim columnToMatch As Integer: columnToMatch = 1
        Dim columnToConcatenate As Integer: columnToConcatenate = 3
        Dim columnToSum As Integer: columnToSum = 4

        lngRow = .Cells(65536, columnToMatch).End(xlUp).Row
        .Cells(columnToMatch).CurrentRegion.Sort key1:=.Cells(columnToMatch), Header:=xlYes

        Do
            If .Cells(lngRow, columnToMatch) = .Cells(lngRow - 1, columnToMatch) Then
                .Cells(lngRow - 1, columnToConcatenate) = .Cells(lngRow - 1, columnToConcatenate) & "; " & .Cells(lngRow, columnToConcatenate)
                .Cells(lngRow - 1, columnToSum) = .Cells(lngRow - 1, columnToSum) + .Cells(lngRow, columnToSum)
                .Rows(lngRow).Delete
            End If

            lngRow = lngRow - 1
        Loop Until lngRow = 1
    End With
End Sub