2014-09-10 142 views
-2

如何匹配来自两列的名称,如果它们相同,则合并两行。意思是first_name和last_name是相同的,然后合并行(因为它们大概是同一个人)。如果行中的其他单元格是相同的,我希望它们只是合并。如果它们不同,我希望通过将两个值保留在组合单元格中,并使用逗号将它们保留在它们之间来保存值。Excel宏通过匹配两列来组合两个excel行

所以这样的:

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 

由于前两行有乔·怀特和乔·怀特之间的匹配(包括姓和名相同)两条线相结合。由于“数字”列具有不同的值,因此它们将以逗号分隔组合在一个单元格中。因为Sign,在这种情况下,天蝎座是相同的,它只是被合并而没有列出两个(重复的)值。在第三个和第四个名称的情况下,只有一个名称匹配(White或Joe),所以它们根本不会组合,因为两个名称必须匹配。

+0

串连两个文件中的两列,然后合并线 – 2014-09-10 13:54:28

+0

@让FrançoisCorbett:我是新来的,我不知道要搜索什么对于。你能指点我什么可以做到的吗? – Dsine 2014-09-10 15:13:00

+0

@KarolMarianSłuszniak:我将这两列连接起来,但是如何合并它?它似乎没有做我上面指出的? – Dsine 2014-09-10 15:13:40

回答

0

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

所以十分首发可能如下:

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 
+0

谢谢。我感谢你的解释和首发。 – Dsine 2014-09-11 00:06:50

+0

这很好。如果这符合你的要求,那么也许你会把它标记为'回答'来清理这个线程。 – barryleajo 2014-09-11 06:47:20