根据单元格值合并范围内的单元格，但不合并最后一个单元格

Question

我有一个范围，其中包含从 A 列到 K 列的数据的行。C 列中单元格值的每个新更改之间已经有空白行。我想根据值是否合并 C 列中的数据相同的加上下面的一个空白行。我绝对需要合并为 B 列中的每个唯一单元格值包含一个空白行，因为我稍后将对值进行分组。

我当前的代码合并了除最后一个唯一值之外的所有内容...有人可以帮助我调整我的代码以便我也可以包含我的最后一个唯一值吗？

Sub MergeSameValue()
Application.DisplayAlerts = False
Dim LastRow As Integer
Dim StartRow As Integer
StartRow = 12
LastRow = Range("B" & Rows.Count).End(xlUp).Row

Dim StartMerge As Integer
StartMerge = StartRow

For i = StartRow + 1 To LastRow + 1
   If Cells(i, 2) <> "" Then
        If Cells(i, 2) <> Cells(i - 1, 2) Then
            Range(Cells(i - 1, 2), Cells(StartMerge, 2)).Merge
            StartMerge = i
        End If
    End If
Next i

End Sub

Answer 1

您的代码声明您当前在循环中检查的单元格不能为空，即 If Cells(i, 2) <> "" Then。如果单元格不为空，则检查是否应合并。

由于最后一部分 永远不会 满足该条件（当 i = 28 时，代码行 Cells(i, 2) <> "" 永远不会为真。所以在我下面的示例中，第 28 行将始终是最后一个单元格，它 永远不会 有值）。因此，您的代码永远不会移动到下一部分：If Cells(i, 2) <> Cells(i - 1, 2) Then... 并尝试合并最后一部分。

您可以通过向单元格 B28 添加一个值来尝试此操作，类别“日记”将被合并。

通过在最后一行添加例外，这将解决您的问题。

注意：我建议仅在合并时隐藏警报。否则，如果代码的不同部分没有按预期工作，很容易感到惊讶，因为它会由于隐藏警报而被隐藏。

完整代码：

Sub MergeSameValue()

Dim LastRow As Long
Dim StartRow As Long
StartRow = 12
LastRow = Range("B" & Rows.Count).End(xlUp).Row

Dim StartMerge As Long
StartMerge = StartRow

For i = StartRow + 1 To LastRow + 1
   If Cells(i, 2) <> "" Then
        If Cells(i, 2) <> Cells(i - 1, 2) Then
            Application.DisplayAlerts = False
            Range(Cells(i - 1, 2), Cells(StartMerge, 2)).Merge
            Application.DisplayAlerts = True
            StartMerge = i
        End If
    End If
    
    If i = LastRow + 1 Then ' for the last row, make an exception and check and run merge
        Application.DisplayAlerts = False
        Range(Cells(i, 2), Cells(StartMerge, 2)).Merge 'To add a blank space for the last row in the merge, remove the -1.
        Application.DisplayAlerts = True
    End If
    
Next i

End Sub

结果：

根据单元格值合并范围内的单元格，但不合并最后一个单元格

Merge cells in a range based on cell value but the last cells aren't being merged

excel

merge

vba