如何高效提取VBA用户表单中激活ToggleButton的Caption并写入单元格

方法一：复用现有toggleButtonCollection集合（高效方案） #

你已经将所有ToggleButton存入集合，直接遍历集合筛选激活状态的按钮，无需重复遍历表单控件，效率更高。

关键调整与代码实现 #

1. 首先在用户表单的通用声明区定义表单级集合变量（确保整个表单生命周期可访问）：

Private toggleButtonCollection As Collection

2. 保留原初始化逻辑，新增命令按钮（示例命名为cmdExport）的点击事件：

Private Sub UserForm_Initialize()
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
    Set toggleButtonCollection = New Collection
    
    Dim ctrl As MSForms.Control
    Dim cToggleButton As clsToggleButton
    
    For Each ctrl In Me.Controls ' 用Me指代当前表单，避免硬编码表单名
        If TypeName(ctrl) = "ToggleButton" Then
            ctrl.BackColor = vbWhite
            Set cToggleButton = New clsToggleButton
            Set cToggleButton.toggleButton = ctrl
            toggleButtonCollection.Add cToggleButton
        End If
    Next ctrl

    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Private Sub cmdExport_Click()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim item As clsToggleButton
    Dim captions As Variant
    Dim i As Integer
    
    ' 指定目标工作表，替换为你的工作表名称
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    ' 获取最后空白行行号
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1
    
    ' 先收集所有激活按钮的Caption，再一次性写入（减少Excel交互次数）
    ReDim captions(1 To toggleButtonCollection.Count)
    i = 0
    
    For Each item In toggleButtonCollection
        If item.toggleButton.Value = True Then
            i = i + 1
            captions(i) = item.toggleButton.Caption
        End If
    Next item
    
    ' 写入工作表
    If i > 0 Then
        ReDim Preserve captions(1 To i)
        ws.Cells(lastRow, "A").Resize(1, i).Value = captions
    End If
End Sub

方法二：直接遍历表单控件（轻量方案） #

若不想维护集合，可直接遍历表单控件筛选激活状态的ToggleButton：

Private Sub cmdExport_Click()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim ctrl As MSForms.Control
    Dim captions As Variant
    Dim i As Integer
    
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1
    
    ReDim captions(1 To Me.Controls.Count)
    i = 0
    
    For Each ctrl In Me.Controls
        If TypeName(ctrl) = "ToggleButton" And ctrl.Value = True Then
            i = i + 1
            captions(i) = ctrl.Caption
        End If
    Next ctrl
    
    If i > 0 Then
        ReDim Preserve captions(1 To i)
        ws.Cells(lastRow, "A").Resize(1, i).Value = captions
    End If
End Sub

高效优化建议 #

• 批量写入数据：先将所有Caption存入数组，再一次性写入工作表，避免逐个单元格操作，大幅提升效率
• 使用Me指代表单：避免硬编码表单名称，让代码更通用、易维护
• 集合复用：若表单包含大量ToggleButton，集合遍历比重复遍历所有控件更快，适合多次操作场景
• 临时关闭刷新与事件：批量操作时关闭Application.ScreenUpdating和Application.EnableEvents，完成后恢复，减少界面卡顿

内容的提问来源于stack exchange，提问作者David Komonyi