Excel：根据单元格值合并单元格的 VBA 脚本

Question

我很难找到一种根据单元格的值合并单元格的方法。这就是我需要的：

我在 D 列和 E 列中有两个依赖的下拉菜单。当在单元格 E12 中选择值“DD9900”时，我想要一个将 E12 与 E13 合并以及 D12 与 D13 合并的脚本。

澄清一下，当 E12 中的值为 DD9900 时，应发生以下合并：

-单元格 E12 与 E13 合并

-单元格 D12 与 D13 合并

示例

ChatGPT 帮助我为单个单元格 (E12) 创建了一个解决方案，但我需要一个代码，将相同的逻辑应用于从 E12 到 E52 的整个范围。

有人可以帮我吗？

谢谢！

这是ChatGPT生成的代码（仅适用于一个单元格）

Private Sub Worksheet_Change(ByVal Target As Range)
    ' Check if the changed cell is E12
    If Not Intersect(Target, Me.Range("E12")) Is Nothing Then
        Application.EnableEvents = False
        ' Clear any previous merges in D12:D13 and E12:E13
        If Me.Range("D12:D13").MergeCells Then Me.Range("D12:D13").Unmerge
        If Me.Range("E12:E13").MergeCells Then Me.Range("E12:E13").Unmerge

        ' Check the value in E12
        If Me.Range("E12").Value = "DD9900" Then
            ' Merge D12:D13 and E12:E13
            Me.Range("D12:D13").Merge
            Me.Range("E12:E13").Merge
        End If
        Application.EnableEvents = True
    End If
End Sub

Answer 1

尝试以下代码。

Target

是被修改的单元格。当单元格不在 E12:E52 范围内时，程序将退出。
我还通过检查是否仅更改了一个单元格来简化了代码 - 如果没有更改（例如通过剪切和粘贴），例程将退出而不执行任何操作。

现在我定义了两个范围变量：

rColD

代表已修改单元格左侧的单元格（

Offset(0, -1)

，即 D 列）加上其下方的下一个单元格 (

Resize(2, 1)

)。

rColE

类似，只是我们不需要

Offset

函数，因为我们已经位于正确的列（E 列）中。

现在我们检查单元格是否获得了魔法值

DD9900

。
如果是并且范围尚未合并，请合并它们。
如果否并且范围已合并，则取消合并。

Private Sub Worksheet_Change(ByVal Target As Range)
    Const theMagicValue = "DD9900"
    
    If Target.Count > 1 Then Exit Sub
    If Intersect(Target, Range("E12:E52")) Is Nothing Then Exit Sub
    
    Dim rColD As Range, rColE As Range
    Set rColD = Target.Offset(0, -1).Resize(2, 1)
    Set rColE = Target.Resize(2, 1)
    
    If Target.Value = theMagicValue Then
        If Not rColD.MergeCells Then rColD.Merge
        If Not rColE.MergeCells Then rColE.Merge
    Else
        If rColD.MergeCells Then rColD.UnMerge
        If rColE.MergeCells Then rColE.UnMerge
    End If
End Sub