Excel 基于列A中的重复值合并行

Excel 基于列A中的重复值合并行,excel,excel-formula,excel-2010,vba,Excel,Excel Formula,Excel 2010,Vba,*注意:我在搜索该网站的第二天,还没有找到一个有效或我能理解的好答案。我不知道编码,这只是为了工作。(我在接下来的6小时内没有时间学习)。请协助,因为我所看到的并不能回答我的问题。我已经发布了我在底部尝试过的许多VBA代码之一。它看起来很接近我需要的,但我不知道如何为我的数据编辑它* 我有一个供应商,它根据从事某项工作的人员来划分工作编号,无论我们要求他们将所有信息放在一行中多少次。所以我的问题是,如何根据作业编号组合行?有多个列与需要合并的行(A-P或1-16)关联,其中A/1列包含重复的作业

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

我有一个供应商,它根据从事某项工作的人员来划分工作编号,无论我们要求他们将所有信息放在一行中多少次。所以我的问题是,如何根据作业编号组合行?有多个列与需要合并的行(A-P或1-16)关联,其中A/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

结束Sub

我强烈建议您花时间了解这是在做什么。我在代码中做了大量的注释,并围绕您的示例代码进行了更改,以将具有相似作业编号的所有行合并在一起

我还没有测试代码,但它应该可以完成这项工作。确保在允许耗尽所有数据之前先对其进行测试

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

可能重复的谢谢!这段代码有几个语法错误。对于i=2到16.cells(lngRow-1,i)value=.cells(lngRow,i).value我很抱歉我是个新手。我保证很快就会学习VBA!对不起。。。是,对于i=2到16,应该是
,我将更新。我在另一行错过了一节课。现在应该好了。不用担心不知道VBA。如果你承担了更多类似的任务,那么通过学习,你会帮自己一个大忙。如果你能理解这段代码,那么你将比大多数人更加精通。非常感谢!