我很难找到一种根据单元格的值合并单元格的方法。这就是我需要的:
我在 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
尝试以下代码。
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