excel - 循环从复选框中提取值

问题描述

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

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

我需要提取给定的选择并将其粘贴到不同的工作表中。使用这个问题，我可以提取每个复选框的值并开发一个 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 循环的情况下改进提取？

编辑对表格的更好描述，以下评论

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

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

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

标签： excelvbacheckbox

解决方案

评论后更新：

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

ChkBox_A1

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

我使用即时窗口查看可以在 VBA 编辑器中通过View->Immediate Window或Ctrl+访问的结果G

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

对于工作表

此代码进入工作表对象

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

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_Initalizesub中的行来生成

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

生产：

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

excel - 循环从复选框中提取值

问题描述

解决方案

推荐阅读