Question

我终于能够编写代码来在合并的单元格中执行多个操作，但是这需要太长时间，我需要合并单元格。

当有人点击一个按钮时，宏会激活，如果激活了一个复选框，它会阻止某些单元格，如果没有，则会阻止另一组单元格。

第一个“If”是复选框的评估。然后它对一些合并的单元格进行一些操作。使用“For each”语句时，代码可以解决问题，因为它使宏运行速度非常慢。

另一种方法是选择每个合并的单元格并逐个应用更改以避免循环，但这将花费一些时间（这只是代码的一部分）。

dim rng as Range

...
with some_worksheet
If .Shapes("checkbox1").ControlFormat.Value = xlOn Then

    For Each rng In .Range("K20:X33")
        rng.MergeArea.Locked = False
    Next rng
        .Range("U29").MergeArea.ClearContents
        For Each rng In .Range("K32:X33")
            rng.MergeArea.ClearContents
        Next rng
    For Each rng In .Range("L26:X33")
        rng.MergeArea.Locked = True
    Next rng
Else
    For Each rng In .Range("K20:X33")
        rng.MergeArea.Locked = False
    Next rng

    For Each rng In .Range("K20:U25")
        rng.MergeArea.ClearContents
    Next rng
    For Each rng In .Range("K28:T31")
        rng.Locked = True
    Next rng
    For Each rng In .Range("K20:AC27")
        rng.Locked = True
    Next rng

    .Range("K28").MergeArea.Locked = True
    .Range("K29").MergeArea.Locked = True
    For Each rng In .Range("K30:AC31")
        rng.Locked = True
    Next rng
End If
End With
...
End Sub

enter image description here

这是Excel屏幕显示（它也需要像这样）。该程序耗时太长，因为它由于显示而循环了很多范围。我将帮助进一步解释宏的作用。

灰色是需要锁定和清除的范围。

当我点击“selection1”时：

它应解锁所有灰色区域，清除“selection2”选择按钮下方的灰色区域，锁定这些单元格并保留字段“K20：U25”可自由编辑。

当我点击“selection2”时，应该反其道而行。

感谢您的快速回复！

Answer 1

尝试使用

Application.ScreenUpdating = False

在功能的开头，

On Error GoTo HERE
: HERE
Application.ScreenUpdating = True

在End Sub之前

在代码完成运行之前，它基本上冻结了excel窗口中的任何更新。它将显着加快运行时间，特别是如果代码中有许多单元格格式。

On Error确保即使代码中途停止，Excel也会解冻

Answer 2

感谢您的回复。 Application.ScreenUpdating有所帮助，但时间仍然很长。

我所做的是在细胞之间进行小循环，而不是使用＆＃34; For Each＆＃34;声明并通过所有这些细胞。

    Dim intloop as integer
    ...
    'Unblock
    if ("checkbox1").ControlFormat.Value = xlOn then
    For intLoop = 0 To 4
        .Range("K2" & intLoop).MergeArea.Locked = False
        .Range("U2" & intLoop).MergeArea.Locked = False
    Next intLoop
    For intLoop = 2 To 3
        .Range("K3" & intLoop).MergeArea.Locked = False
        .Range("U3" & intLoop).MergeArea.Locked = False
    Next intLoop
    .Range("U28").MergeArea.Locked = False
    .Range("U29").MergeArea.Locked = False
    'Data delete
    .Range("U28").Font.Color = RGB(255, 255, 255)
    .Range("U29").MergeArea.ClearContents
    For intLoop = 2 To 3
        .Range("K3" & intLoop).MergeArea.ClearContents
        .Range("U3" & intLoop).MergeArea.ClearContents
    Next intLoop
    'Block
    For intLoop = 2 To 3
        .Range("K3" & intLoop).MergeArea.Locked = True
        .Range("U3" & intLoop).MergeArea.Locked = True
    Next intLoop
    .Range("U28").MergeArea.Locked = True
    .Range("U29").MergeArea.Locked = True
Else
    'Unblock
    For intLoop = 0 To 4
        .Range("K2" & intLoop).MergeArea.Locked = False
        .Range("U2" & intLoop).MergeArea.Locked = False
    Next intLoop
    For intLoop = 2 To 3
        .Range("K3" & intLoop).MergeArea.Locked = False
        .Range("U3" & intLoop).MergeArea.Locked = False
    Next intLoop
    .Range("U28").MergeArea.Locked = False
    .Range("U29").MergeArea.Locked = False
    'Data delete
    .Range("U28").Font.Color = RGB(0, 0, 0)
    For intLoop = 0 To 4
        .Range("K2" & intLoop).MergeArea.ClearContents
        .Range("U2" & intLoop).MergeArea.ClearContents
    Next intLoop
    'Block
    For intLoop = 0 To 4
        .Range("K2" & intLoop).MergeArea.Locked = True
        .Range("U2" & intLoop).MergeArea.Locked = True
    Next intLoop
    End if
    ...
    End sub

如您所见，代码更长但速度更快。

使用＆＃34;将属性更改为多个合并的单元格，对于每个＆＃34;需要太长时间的VBA

2 个答案: