将相邻的单元格仅合并到一个范围内的合并单元格

我正在尝试将相邻行中的单元格合并到已经合并的单元格中。 如果合并列D中的相邻单元格,我想合并列C中的一个相邻单元格。 并非所有的单元格都在D列合并。我有下面的代码,当我在MsgBox中使用该variables时提供了正确的行号,但是,当我将该variables添加到要合并的范围,每一行都合并。 我想这一定是一些简单的,但我可以确定是什么导致范围内的每一行合并。 我通常不会合并任何东西,但我需要离开电子表格与这些合并单元格。 你的帮助来破解这一个将不胜感激。

Sub FindMerge() Dim cell As Range Dim Lrow As Long Application.ScreenUpdating = False 'Turn off screen updating. Code runs faster without screen flicker Application.DisplayAlerts = False 'stops Windows Alerts from poping up 'loops through range to find merged cells 'For Each cell In ActiveSheet.UsedRange 'commented out to try static range below. For Each cell In Range("D1:D81") If cell.MergeCells Then If cell.Address = cell.MergeArea.Cells(1, 1).Address Then ' Msgbox "Row: " & cell.row 'displays correct row number where merged cell is located Lrow = cell.row Range("C2:O" & Lrow).Merge True 'Unintentionally merges every row End If End If Next cell Application.ScreenUpdating = True 'Turns screen updating back on Application.DisplayAlerts = True 'Turns Windows Alerts back on End Sub 

您正在合并从第2行开始的所有行:

Range("C2:O" & Lrow).Merge

你最想要的是这样的:

 Range("C1:O1").Offset(Lrow - 1).Merge