循环从复选框中提取值

Question

我正在使用的表单有 10 个复选框，值从 1 到 10，用于回答多项选择题。

多个值在技术上是可行的（单击多个框），但不允许使用（在填充时，只能给出一个值）。我无法修改此表单，因此我必须使用此设置。

我需要提取给定的选项并将其粘贴到不同的工作表中。 使用this question，我可以提取每个复选框的值并开发一个 IF 循环。

If ExtractionSheet.Shapes("Check Box 1").OLEFormat.Object.Value = 1 Then

Database.Cells(5, 9).Value = 1

ElseIf ExtractionSheet.Shapes("Check Box 2").OLEFormat.Object.Value = 1 Then

Database.Cells(5, 9).Value = 2

ElseIf ExtractionSheet.Shapes("Check Box 3").OLEFormat.Object.Value = 1 Then

Database.Cells(5, 9).Value = 3

...

但是，这看起来效率不高（我有 3 组，每个表单有 1-10 个复选框和 100 多个表单）。鉴于设置，我无法找到更好的方法。

如何在不使用 IF 循环的情况下改进提取？

EDIT 对表单的更好描述，在 cmets 之后

这是一个简单的 Excel 工作表，其中粘贴了 3 组，每组 10 个复选框元素。

每个表单/工作表都与单个项目相关。在评估期间，对于每个项目，我们将为属性 1（前 10 个复选框）分配一个介于 1 和 10 之间的值，为属性 2（后 10 个复选框）分配一个介于 1 和 10 之间的值，并为属性分配一个介于 1 和 10 之间的值3（第三个 10 个复选框）。

我将在给我数据以填充它的客户面前进行填充（物理单击框）。点击多个框的可能性自然存在；我认为这并不重要，因为我这样做时很多人会看着屏幕，但我可以稍后再添加一个检查。

Answer 1

在cmets之后更新：

我对@9​​87654329@ 使用了以下命名约定（仅使用例如 A1 是单元格引用，可能会导致问题）

ChkBox_A1

第一部分表示它是checkbox (ChkBox)，第二部分表示A，第三部分表示位置1。使用此命名约定以及当前代码的编写方式，您最多可以拥有 26 个组（即，每个字母对应一个）

我使用即时窗口查看可以在 VBA 编辑器中访问的结果，方法是转到 View->Immediate Window 或 Ctrl+G

此代码将处理每个组的单选。即如果在组中选中了一个复选框，它将取消选择所有其他复选框

对于工作表

此代码位于工作表对象中

替换所有点击语句（例如 ChkBox_A1_Click() 参考您自己的。这可以通过调用 GenerateChkBoxClickStmt 子并将即时窗口中的输出复制并粘贴到您的代码中轻松完成（替换我的）

Option Explicit
Dim ChkBoxChange As Boolean
Private Sub ChkBox_A1_Click()
    If ChkBoxChange = False Then UnselectPreviousChkBox Me.ChkBox_A1
End Sub
Private Sub ChkBox_A2_Click()
    If ChkBoxChange = False Then UnselectPreviousChkBox Me.ChkBox_A2
End Sub
Private Sub ChkBox_B1_Click()
    If ChkBoxChange = False Then UnselectPreviousChkBox Me.ChkBox_B1
End Sub
Private Sub UnselectPreviousChkBox(selected As Object)
    Dim ChkBox As OLEObject

    ChkBoxChange = True

    For Each ChkBox In Me.OLEObjects
        If ChkBox.progID = "Forms.CheckBox.1" Then
            If ChkBox.Name <> selected.Name And Mid(ChkBox.Name, 8, 1) = Mid(selected.Name, 8, 1) Then
                ChkBox.Object.Value = False
            End If
        End If
    Next ChkBox

    ChkBoxChange = False
End Sub
Private Sub GenerateChkBoxClickStmt()
    Dim ChkBox As OLEObject
    ' Copy and paste output to immediate window into here

    For Each ChkBox In Me.OLEObjects
        If ChkBox.progID = "Forms.CheckBox.1" Then
            Debug.Print "Private Sub " & ChkBox.Name & "_Click()"
            Debug.Print vbTab & "If ChkBoxChange = False Then UnselectPreviousChkBox Me." & ChkBox.Name
            Debug.Print "End Sub"
        End If
    Next ChkBox
End Sub

产生以下内容：

这段代码进入一个模块

Option Explicit
Private Function GetChkBoxValues(ChkBoxGroup As Variant) As Long
    Dim ChkBox As OLEObject

    ' Update with your sheet reference
    For Each ChkBox In ActiveSheet.OLEObjects
        If ChkBox.progID = "Forms.CheckBox.1" Then
            If ChkBox.Object.Value = True And Mid(ChkBox.Name, 8, 1) = ChkBoxGroup Then
                GetChkBoxValues = Right(ChkBox.Name, Len(ChkBox.Name) - (Len("ChkBox_") + 1))
                Exit For
            End If
        End If
    Next ChkBox
End Function
Public Sub GetSelectedChkBoxes()
    Dim ChkBoxGroups() As Variant
    Dim Grp As Variant

    ChkBoxGroups = Array("A", "B", "C")

    For Each Grp In ChkBoxGroups
        Debug.Print "Group " & Grp, GetChkBoxValues(Grp)
    Next Grp
End Sub

通过运行GetSelectedChkBoxes，代码将输出到即时窗口：

对于用户表单

类似地，点击事件的语句可以通过取消注释Userform_Initalize sub 中的行来生成

Option Explicit
Dim ChkBoxChange As Boolean
Private Function GetChkBoxValues(Group As Variant) As Long
    Dim ChkBox As Control

    For Each ChkBox In Me.Controls
        If TypeName(ChkBox) = "CheckBox" Then
            If ChkBox.Object.Value = True And Mid(ChkBox.Name, 8, 1) = Group Then
                GetChkBoxValues = Right(ChkBox.Name, Len(ChkBox.Name) - (Len("ChkBox_") + 1))
                Exit For
            End If
        End If
    Next ChkBox
End Function
Private Sub UnselectPreviousChkBox(selected As Control)
    Dim ChkBox As Control
    ChkBoxChange = True
    For Each ChkBox In Me.Controls
        If TypeName(ChkBox) = "CheckBox" Then
            If ChkBox.Name <> selected.Name And Mid(ChkBox.Name, 8, 1) = Mid(selected.Name, 8, 1) Then
                ChkBox.Value = False
            End If
        End If
    Next ChkBox
    ChkBoxChange = False
End Sub
Private Sub ChkBox_A1_Click()
    If ChkBoxChange = False Then UnselectPreviousChkBox Me.ChkBox_A1
End Sub
Private Sub ChkBox_A2_Click()
    If ChkBoxChange = False Then UnselectPreviousChkBox Me.ChkBox_A2
End Sub
Private Sub ChkBox_B1_Click()
    If ChkBoxChange = False Then UnselectPreviousChkBox Me.ChkBox_B1
End Sub
Private Sub userform_initialize()
    ' Comment out once written
    ' GenerateChkBoxClickStmt
End Sub
Private Sub UserForm_Terminate()
    Dim ChkBoxGroups() As Variant
    Dim Grp As Variant

    ChkBoxGroups = Array("A", "B", "C")

    For Each Grp In ChkBoxGroups
        Debug.Print "Group " & Grp, GetChkBoxValues(Grp)
    Next Grp
End Sub
Private Sub GenerateChkBoxClickStmt()
    Dim ChkBox As Control
    ' Copy and paste output to immediate window into here
    For Each ChkBox In Me.Controls
        If TypeName(ChkBox) = "CheckBox" Then
            Debug.Print "Private Sub " & ChkBox.Name & "_Click()"
            Debug.Print vbTab & "If ChkBoxChange = False Then UnselectPreviousChkBox Me." & ChkBox.Name
            Debug.Print "End Sub"
        End If
    Next ChkBox
End Sub

制作：

并在退出时输出以下内容：