根据 A 列中的重复值组合行

Question

*注意：我在搜索此站点的第二天，还没有找到一个有效的或我能够理解的好答案。我不知道编码，这只是为了工作。 （我在接下来的 6 个小时内没有时间学习它）。请协助，因为我所看到的并不能回答我遇到的问题。我已经在底部发布了我尝试过的众多 VBA 代码之一。它看起来接近我需要的东西，但我不知道如何为我的数据编辑它。 *

我有一个供应商，无论我们要求他们将所有信息放在一行中多少次，它都会根据谁从事该工作的一部分来区分工作编号。所以我的问题是，如何根据工作编号组合行？有多个列与需要组合的行关联，A-P 或 1-16，其中 A/1 列包含重复的作业编号。我不需要总和，因为所有列都是文本或日期。我只需要组合行，如果一列有多个不同的条目，则 cmets 用逗号分隔。例如：

前两行是我收到的示例，第五行是我需要的（我为示例隐藏了一些列）。如您所见，任何具有重复值的列都会被压缩，只有 1 个条目的列只复制该单个条目，具有多个不同条目的列将所有条目组合到一个单元格中，并用逗号分隔每个条目。

我知道手工操作似乎很简单，但是其中一些工作编号重复了 20 次，当供应商再次错误地提交信息时，我每周要处理 600 多个这样的工作编号。

这是我尝试过的 VBA 代码之一。这是原版。我不会向您展示我是如何尝试为我的工作编辑它的……因为我知道这太可怕了。请协助！

子合并类别值（） 将行变暗

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

结束子

Answer 1

我强烈建议您花时间了解它的作用。我在代码中制作了大量 cmets，并围绕您的示例代码进行了更改，以将具有相似工作编号的所有行合并在一起。

我还没有测试过代码，但它应该可以完成这项工作。请务必先对其进行测试，然后再吃掉所有数据。

Sub mergeCategoryValues() 
    Dim lngRow As Long

    'This is using activesheet, so make sure your worksheet is 
    ' selected before running this code.
    With ActiveSheet

        'We are looking for duplicate Job Numbers
        '  which is column 1. Set that here if it needs
        '  to change.
        Dim columnToMatch As Integer: columnToMatch = 1

        'Figure out the last row
        lngRow = .Cells(65536, columnToMatch).End(xlUp).Row

        'Sort the records by the column we will use to match . Column A holds the Job Number
        .Cells(columnToMatch).CurrentRegion.Sort key1:=.Cells(columnToMatch), Header:=xlYes

        'Loop through each row starting with last and working our way up.
        Do

            'Does this row match with the next row up accoding to the Job Number in Column A?
            If .Cells(lngRow, columnToMatch) = .Cells(lngRow - 1, columnToMatch) Then

                'Loop through columns B though P
                For i = 2 to 16

                    'Determine if the next row up already has a value. If it does leave it be
                    '   if it doesn't then use the value from this row to populate the next
                    '   next one up.
                    If .Cells(lngRow - 1, i).value = "" Then
                        .cells(lngRow - 1, i).value = .cells(lngRow, i).value
                    End if
                Next i

                'Now that we've processed all of the columns, delete this row
                '   as the next row up will have all the values
                .Rows(lngRow).Delete
            End If

            'Go to the next row up and do it all again.
            lngRow = lngRow - 1
        Loop Until lngRow = 1
    End With
End Sub