在 Excel 中使用 VBA 循环复选框非常慢

Question

我有一个包含大约 4500 个复选框的 Excel 表（我知道，这听起来很愚蠢，但它是给客户的，请不要问......）。 刚刚在下面写了 VBA Sub 来取消选中所有框。 到目前为止它可以工作，但它非常慢，需要超过 5 分钟，直到所有 boce 都被取消检查，并且在 Sub 运行时，整个 Excel Applikation 变灰冻结。 我知道，4500 Checkboxes 安静了很多，但我想知道它是否真的足以让 Excel 陷入这样的麻烦......有没有人有想法？

最佳迈克尔

Sub DeselectAll()
   Application.EnableCancelKey = False
   Application.Calculation = xlCalculationManual
   Application.ScreenUpdating = False
   Application.EnableEvents = False
   Dim wksA As Worksheet
   Dim intRow As Integer

   Set wksA = Worksheets("Companies")
   For intRow = 1 To 4513
      wksA.CheckBoxes("Checkbox_" & intRow).Value = False
   Next
 End Sub

Answer 1

无选择：

Sub DeselectAll()
  With Worksheets("Companies").CheckBoxes
   .Value = xlOff
  End With
End Sub

Answer 2

只是不要循环。

这是选择何时可以提供帮助的一个很好的例子：

要设置所有复选框：

Sub dural()
    ActiveSheet.CheckBoxes.Select
    Selection.Value = xlOn
End Sub

要取消选中所有复选框：

Sub dural2()
    ActiveSheet.CheckBoxes.Select
    Selection.Value = xlOf
End Sub

（在表单类型复选框上测试）

Answer 3

我赞成的最佳答案是@EvR 解决方案。 我不是要回答，而是提供一个解决方法的想法。

我通过在带有简单 3 行循环的空白工作簿中的空白工作表中添加 4000 ComboBox 来检查时间（我忘了关闭屏幕更新和计算等）。 在我的旧笔记本电脑上花了大约 10 分钟。 我没有勇气再次重蹈覆辙。

当我尝试使用您的代码进行循环时，它只需要 3-4 秒，而@EvR 的解决方案没有循环和选择需要 1-2 秒。 这些时间是使用Debug.Print或写入某些单元格所花费的实际时间。 实际的戏剧在屏幕更新、计算、事件在工作表处于活动状态的情况下展开。 它变得非常不稳定，任何粗心的点击等都会导致 excel 在 2-5 分钟内处于“无响应”状态。

虽然客户和老板总是对的。 在我的一生中，有一次我成功地用工作表上数百个按钮的类似方法说服了某人使用虚拟的东西。 我的想法是在工作表中创建虚拟复选框。 适当的单元格大小和边界与单元格验证为`=ChrW(&H2714)' 并忽略空白和下面的简单代码可以使其成为一种传递类型的解决方法。

Public Prvsel As Range
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim isect, Cl As Range
Set isect = Application.Intersect(Target, Range("C1:C4000"))

    If isect Is Nothing Then
    Set Prvsel = Nothing  'Release multiple selection
    Exit Sub
    End If

    If isect.Cells.Count > 1 Then
    Set Prvsel = isect        'storing multiple selection for next click event
    Else
        If Target.Value = ChrW(&H2714) Then
        Target.Value = ""
        Else
        Target.Value = ChrW(&H2714)
        End If
        If Not Prvsel Is Nothing Then
            For Each Cl In Prvsel.Cells
            Cl.Value = Target.Value
            Next Cl
        End If
    End If
End Sub

Answer 4

详细说明@Ahmed AU 解决方案。

选择/取消选择信号/多个虚拟复选框

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim isect As Range
Dim Cl As Range
Dim Prvsel As Range
Set isect = Application.Intersect(Target, Range("C1:C4000"))
If isect Is Nothing Then
Set Prvsel = Nothing  'Release multiple selection
Exit Sub
End If

' Use WINGDING font Chr (254) for checked
' Use WINGDING font Chr (111) for uncheck

If isect.Cells.Count >= 1 Then
Set Prvsel = isect        
    For Each Cl In Prvsel.Cells
            If Cl.Value = Chr(111) Then
                Cl.Value = Chr(254)
                Else
                Cl.Value = Chr(111)
            End If
    Next Cl
End If
'Go to offset cell selection
       Selection.Offset(0, 1).Select
    End Sub