Question

如何匹配两列中的名称，如果它们相同，则合并两行。意味着如果first_name和last_name相同则组合行（因为它们可能是同一个人）。如果行中的其他单元格相同，我希望它们只是组合。如果它们不同，我希望保存两个值/字符串，方法是将它们放在组合单元格中，并在它们之间用逗号。

所以这个：

First  Last     Number   Sign
Joe    White    1122     Scorpio
Joe    White    1144     Scorpio
Joe    Jones    11445    Leo
David  White    112      Virgo

应该变成这个：

First       Last        Number       Sign
Joe         White        1122, 1144  Scorpio
Joe         Jones        11445       Leo
David       White        112         Virgo

由于前两行在Joe White和Joe White之间有匹配（名字和姓氏相同），因此两行合并。由于Number列具有不同的值，因此它们将以逗号分隔的方式组合在一个单元格中。因为Sign（在本例中是Scorpio）是相同的，它只是组合而不列出两个（重复）值。在第三个和第四个名称的情况下，只有一个名称匹配（白色或乔），因此它们不会合并，因为两个名称必须匹配。

Answer 1

OK Dsine这是一个建议。 SO的一部分精神是你应该展示和分享你目前已经尝试过的东西。一个起点可能是用文字记下你如何解决你的问题，尝试编码并研究你的差距。请参阅下面代码中的我的评论作为可能的示例。如果你仍然卡住了。然后发布你的问题。

所以10的首发可以如下：

Sub concat()

Dim sdRow As Long, sdcol As Long, ldRow As Long, ldCol As Long
Dim rowNo As Long, resultRow As Long
Dim ws1 As Worksheet, ws2 As Worksheet
Dim keyVal As String

'assume original data is in Sheets("Data")
'assume result data is in Sheets("Data2")
Set ws1 = Sheets("Data")
Set ws2 = Sheets("Data2")

'original data block r/c
sdRow = 2
sdcol = 1
ldRow = ws1.Cells(Rows.Count, 1).End(xlUp).Row
ldCol = ws1.Cells(sdRow, Columns.Count).End(xlToLeft).Column

'assume result data set in Sheets("Data2") is placed in same sheet position
'as in Sheets("Data") and copy headings
ws1.Activate
ws1.Range(Cells(sdRow, sdcol), Cells(sdRow, ldCol)).Copy _
Destination:=ws2.Cells(sdRow, sdcol)

'sort original data
 ws1.Activate
    ws1.Range(Cells(sdRow, sdcol), Cells(ldRow, ldCol)).Select
    Selection.Sort Key1:=Columns(sdcol), Order1:=xlAscending, _
        Key2:=Columns(sdcol + 1), Order2:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal

'loop through original data
rowNo = sdRow + 1
resultRow = rowNo

Do While rowNo < ldRow
    'Test if names are the same
    keyVal = Cells(rowNo, sdcol) & Cells(rowNo, sdcol + 1)
        If keyVal = Cells(rowNo + 1, sdcol) & Cells(rowNo + 1, sdcol + 1) Then
            'copy data row to Sheet("Data2")
            ws1.Range(Cells(rowNo, sdcol), Cells(rowNo, ldCol)).Copy _
            Destination:=ws2.Cells(resultRow, sdcol)

            'modify 'Number' cell in Sheet("Data2") if required
                If ws1.Cells(rowNo, sdcol + 2) = ws1.Cells(rowNo + 1, sdcol + 2) Then
                    'do nothing
                Else
                    ws2.Cells(resultRow, sdcol + 2) = Str(ws1.Cells(rowNo, sdcol + 2)) & "," & Str(ws1.Cells(rowNo + 1, sdcol + 2))
                End If

             'modify 'Sign' cell in Sheet("Data2") if required
                If ws1.Cells(rowNo, sdcol + 3) = ws1.Cells(rowNo + 1, sdcol + 3) Then
                    'do nothing
                Else
                    ws2.Cells(resultRow, sdcol + 3) = ws1.Cells(rowNo, sdcol + 3) & "," & ws1.Cells(rowNo + 1, sdcol + 3)
                End If

            resultRow = resultRow + 1

        Else
            'copy data 'as is' to Sheet("Data2")
            ws1.Range(Cells(rowNo, sdcol), Cells(rowNo, ldCol)).Copy _
            Destination:=ws2.Cells(resultRow, sdcol)

            resultRow = resultRow + 1

        End If

    rowNo = rowNo + 1

Loop

End Sub

Excel宏通过匹配两列来组合两个excel行

1 个答案: