Цикл для извлечения значения из флажка

Question

Форма, с которой я работаю, имеет 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 флажков), значение от 1 до 10 для свойства 2 (вторые 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() со ссылкой на свой собственный. Это можно легко сделать, вызвав подпрограмму 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

Производство:

и вывод на выходе следующего: