如果特定列中的单元格相同，则合并并删除Excel中的行

我沿着这些路线search了一些东西，但找不到任何我正在寻找的答案。 我所拥有的是一个按尺寸分开的服装物品的电子表格。 例如：

Product Name | Image | Color | Size _______________________________________________ tshirt | tshirt.jpg | White | Small tshirt | tshirt.jpg | White | Medium tshirt | tshirt.jpg | White | Large polo | polo.jpg | Blue | Small polo | polo.jpg | Blue | Medium polo | polo.jpg | Blue | Large ... 

我想要发生的是同一个项目的所有尺寸被压缩成一行，如下所示：

 Product Name | Image | Color | Size _______________________________________________ tshirt | tshirt.jpg | White | Small Medium Large polo | polo.jpg | Blue | Small Medium Large ... 

我发现这个脚本，但它只是删除行，并没有合并到一个单元格的大小：

 Sub removeDups() Dim myRow As Long Dim sTRef As String sTRef = Cells(2, 2) myRow = 1 Do While (Cells(myRow, 2) <> "") If (sTRef <> Cells(myRow, 2)) Then sTRef = Cells(myRow, 2) myRow = myRow + 1 Else Rows(myRow).Select Selection.Delete Shift:=xlUp End If Loop End Sub 

如何在删除行之前修改此脚本以合并大小？

Answer 1

使用这个代码（我想你的大小在列“E”）：

 Sub removeDups() Dim myRow As Long Dim sTRef As String sTRef = Cells(2, 2) myRow = 3 Do While Cells(myRow, 2) <> "" If sTRef <> Cells(myRow, 2) Then sTRef = Cells(myRow, 2) myRow = myRow + 1 Else Cells(myRow - 1, "E") = Cells(myRow - 1, "E") & " " & Cells(myRow, "E") Rows(myRow).Delete Shift:=xlUp End If Loop End Sub 

Answer 2

simoco的答案可以更一般化如下：

数据集：

 ╔══════════════╦════════════╦═══════╦════════╦════════════════╗ ║ Product Name ║ Image ║ Color ║ Size ║ E-mail ║ ╠══════════════╬════════════╬═══════╬════════╬════════════════╣ ║ tshirt ║ tshirt.jpg ║ White ║ Small ║ [e-mail] ║ ║ tshirt ║ tshirt.jpg ║ White ║ Medium ║ [e-mail] ║ ║ tshirt ║ tshirt.jpg ║ White ║ Large ║ [e-mail] ║ ║ polo ║ polo.jpg ║ Blue ║ Small ║ [e-mail] ║ ║ yolo ║ ║ Blue ║ Medium ║ [e-mail] ║ ║ holo ║ ║ Blue ║ Large ║ [e-mail] ║ ║ rolo ║ polo.jpg ║ ║ Small ║ [e-mail] ║ ║ yolo ║ polo.jpg ║ Blue ║ Medium ║ [e-mail] ║ ║ holo ║ ║ Blue ║ Large ║ [e-mail] ║ ║ rolo ║ ║ ║ Small ║ [e-mail] ║ ╚══════════════╩════════════╩═══════╩════════╩════════════════╝ 

假设：

• 让列E包含你想合并成一个的值。
• 设5是工作表中存在的列的数量。
• 让我们合并所有其他列中不相等的所有单元格。
• 让我们引入一个％符号，以便我们可以使用条件格式来查找数据已经被合并的所有单元格。
• 让我们考虑空单元格。

结果代码是：

 Sub removeDups() Dim myRow As Long Dim sTRef As String sTRef = Cells(2, "E") myRow = 3 Do While Cells(myRow, "E") <> "" If sTRef <> Cells(myRow, "E") Then sTRef = Cells(myRow, "E") myRow = myRow + 1 Else For i = 1 To 5 If Cells(myRow - 1, i) = "" Then Cells(myRow - 1, i) = Cells(myRow, i) Else If Cells(myRow, i) = Cells(myRow - 1, i) Then Cells(myRow - 1, i) = Cells(myRow, i) Else If Cells(myRow, i) <> "" Then Cells(myRow - 1, i) = Cells(myRow - 1, i) & " % " & Cells(myRow, i) End If End If End If Next i Rows(myRow).Delete Shift:=xlUp End If Loop End Sub 

simoco，谢谢你！

Answer 3

我的解决scheme假定每个柱子必须是相同的，除了要合并的值的柱子。

将VBA模块中的代码链接到正在处理的工作表上。 就像在你的例子中，它假设表格被sorting。

 Const MergeCol = 4 Sub MergeRows() Dim Row As Long Dim Col As Long Dim Equal As Boolean With Me.UsedRange For Row = 3 To .Rows.Count If Not IsEmpty(.Cells(Row, 1)) Then Equal = True For Col = 1 To .Columns.Count If Col <> MergeCol Then If .Cells(Row - 1, Col).Value <> .Cells(Row, Col).Value Then Equal = False Exit For End If End If Next Col If Equal Then ' Merge With .Cells(Row - 1, MergeCol) .Value = .Value & ", " & Me.Cells(Row, MergeCol).Value End With .Rows(Row).Delete Row = Row - 1 End If End If Next End With End Sub