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

...

但是，这看起来效率不高（我在每份表单和100多种表单中有3套1-10个复选框）。有了设置，我就找不到更好的方法。

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

编辑，下面的注释对表单有更好的描述

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

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

我将在客户面前进行填充（实际上是单击该框），客户正在给我数据以填充它。当然，也可以单击多个框。我认为这不是至关重要的，因为在我这样做的同时，会有很多人看着屏幕，但是以后我总是可以添加检查。

Answer 1

评论后更新：

我对checkboxes使用了以下命名约定（例如，仅使用A1作为单元格引用，可能会引起问题）

ChkBox_A1

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

我使用立即窗口显示结果，可以在VBA编辑器中访问View-> Immediate Window或 Ctrl + G

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

用于工作表

此代码在工作表对象中

将所有的click语句（例如，ChkBox_A1_Click()替换为您自己的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子行中的行来生成click事件的语句

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

制作：

并在出口处输出以下内容：

循环从复选框中提取值

1 个答案: