VBA_把相同行一列追加数据到一行

Sub Test()
    Dim rowsNum, i, j, equalRowsNum As Integer
    rowsNum = ActiveSheet.UsedRange.Rows.Count '获得行数

    For i = 3 To rowsNum '遍历全部行数
     If Cells(i, 1).Value = Cells(i + 1, 1).Value Then
        j = j + 1
    Else

        For equalRowsNum = 1 To j
        '给指定列追加数值。把相同行的同列追加到第一相同行
        Cells(i - j, 6).Value = CStr(Cells(i - j, 6).Value) + Chr(10) + CStr(Cells(i - j + equalRowsNum, 6).Value)
        Next

        j = 0

     End If

    Next

    'Debug.Print rowsNum
End Sub