如何合并行中重复的单元格值？我的代码忽略了一些重复的值

Posted 2023-03-29

【中文标题】如何合并行中重复的单元格值？我的代码忽略了一些重复的值

【英文标题】：How to merge duplicate cell values in rows? My code is ignoring some of the duplicate values

【发布时间】：2021-10-15 14:02:14

【问题描述】：

我正在尝试合并 D 列中所有连续的重复单元格。我不关心单元格的格式，也不需要对任何值求和。想知道我下面的代码有什么问题，因为并非所有重复的单元格都在合并...只能假设我不小心跳过了它们

with thisworkbook.sheets("sheet1") 
For i = StartRow + 1 To LastRow + 1
    
If Cells(i, 4) <> "" Then
    If Cells(i, 4) <> Cells(i - 1, 4) Then
        Application.DisplayAlerts = False
        Range(Cells(i - 2, 4), Cells(StartMerge, 4)).Merge
        Application.DisplayAlerts = True
        StartMerge = i
    End If
End If
Next i
End With

【问题讨论】：

看看this有没有帮助

嗨纳雷什。这对我来说有点令人困惑，因为用户在确定合并时似乎引用了空白单元格？我希望我可以让我的代码完全专注于类似于 if a1 = a2, a2 = a3, a3 a4 then a1:a3.merge 然后在 a4 重复直到最后一个具有值的单元格的逻辑。我只是对循环没有信心。

Range(Cells(i - 2, 4), Cells(StartMerge, 4)).Merge 可能是问题所在。 StartMerge 的初始值在哪里？你能改用i吗？另外，为什么i - 2 而不是i - 1？

抱歉信息不足！ startmerge = startrow，我之前命名为 12。标题从 d12 开始，数据行从 d13 开始，所以我一直在摆弄数字..i - 1 表示 i 之前的单元格对吗？ （例如，如果 i = d13，则 i - 1 = d12）

【参考方案1】：

接近您的代码： （已更新；已删除 If Cells(i, 4) <> "" Then）

Sub test1()
    With ThisWorkbook.Sheets("sheet1")
        StartRow = 1
        LastRow = .Cells(.Rows.Count, 4).End(xlUp).Row
        
        StartMerge = StartRow + 1
        Application.DisplayAlerts = False
        For i = StartRow + 1 To LastRow
            If .Cells(i, 4) <> .Cells(i + 1, 4) Then
                .Range(.Cells(StartMerge, 4), .Cells(i, 4)).Merge
                StartMerge = i + 1
            End If
        Next i
        Application.DisplayAlerts = True
    End With
End Sub

结果：

【讨论】：

可能是因为If Cells(i, 4) <> "" Then这行。查看代码的更新版本

您好！再次感谢你。我意识到它提前停止的原因是因为我使用“mergelastrow”来表示这段代码的最后一行。 "If Cells(i,4) "" Then 仍然有效。我不小心使用了“lastrow”，它代表另一列数据的最后一行。这很好用:)

【参考方案2】：

您可以使用数据透视表快速获得如下所示的视图。只是另一个没有编码的想法。仅供参考。

【讨论】：

谢谢！不幸的是，我必须合并值，以便稍后将它们分组。

【参考方案3】：

索引、评估和过滤函数方法以避免循环遍历每个单元格。使用这些函数，以下过程会创建一个行号数组，其中单元格中的值与上述单元格值不匹配。

然后循环遍历数组以合并所需的“相同”单元格。

Sub MergeSameCells()
Dim ColRng As Range, RowArr
Application.DisplayAlerts = False
Set ColRng = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)

RowArr = Filter(Application.Transpose(Application.Index( _
            Evaluate("IF((" & ColRng.Address & "<>" & ColRng.Offset(1).Address & _
            "),ROW(" & ColRng.Address & "),""NA"")") _
            , 0, 1)), "NA", False, vbTextCompare)
Debug.Print UBound(RowArr)
'result 5, So there will be 6 loops (Zero based array) instead of 13.
For i = UBound(RowArr) To 0 Step -1
    If i = 0 Then
        If RowArr(i) - 1 <> 1 Then
        Range(Cells(2, "B"), Cells(RowArr(i), "B")).Merge
        End If
    Else
        If RowArr(i) - RowArr(i - 1) <> 1 Then
        Range(Cells(RowArr(i - 1) + 1, "B"), Cells(RowArr(i), "B")).Merge
        End If
    End If
Next i
Application.DisplayAlerts = True
End Sub

【讨论】：

循环次数对于小范围无关紧要。

正确。它只适用于小范围。