使用循环从对应于正确复选框的命名范围中提取数据，

Question

因此，我在一个用户窗体中运行以下内容，该用户窗体应从已选中组框中的每个复选框的命名范围中提取简短代码，然后将其打印到工作表中的所需单元格中。

Dim AirExGroup As Frame
Dim TrkExGroup As Frame
Dim OthrExgroup As Frame
Dim cb As Control

Set AirExGroup = Me.AirExGrp        'Contains all Air exception checkboxes
Set TrkExGroup = Me.TruckExGrp      'Contains all Truck exception checkboxes
Set OthrExgroup = Me.OthrExGrp      'Contains all Other exception checkboxes

'Airline Exceptions
For Each cb In AirExGroup.Controls
    If TypeName(cb) = "CheckBox" Then
        If cb.ControlFormat.Value = 1 Then
            'If checked, print Brevity code from Air_Ex list to Air Exception Column
        Else
            'If no boxes checked, print "N/A" in exceptions cell
    End If
  End If
Next cb

'Trucker Exceptions
For Each cb In TrkExGroup.Controls
    If TypeName(cb) = "CheckBox" Then
        If cb.ControlFormat.Value = 1 Then
             'If checked, print Brevity code from Trk_Ex list
        Else
             'If no boxes checked, print "N/A" in exceptions cell
    End If
  End If
Next cb

'Warehouse Exceptions
For Each cb In OthrExgroup.Controls
    If TypeName(cb) = "CheckBox" Then
        If cb.ControlFormat.Value = 1 Then
            'If checked, print Brevity code from Othr_Ex list
        Else
            'If no boxes checked, print "N/A" in exceptions cell
        End If
    End If
Next cb`

我遇到的问题是我一生都无法弄清楚如何获取选中哪个复选框的部分，如何从代码列表中提取正确的简短代码并将其打印到纠正工作表上的单元格。我尝试使用下面的方法将该数据加载到数组中，但是可以说，我无法使两者相互交谈。我找到了很多解决方案来检查一组复选框是对还是错，还有很多用于从数组中提取数据的解决方案，但是我在这里找不到任何讨论串联工作的东西，不幸的是，我仍然没有经验来独自设计新颖的解决方案。

Dim Exceptions(1 To 8, 1 To 2) As String
Dim i As Integer, j As Integer
Dim cb As Shape

For i = 2 To 8
    For j = 1 To 2
        Exceptions(i, j) = Worksheets("List_Data").Cells(i, j).Value
    Next j
Next i

MsgBox Exceptions(4, 1) & ", " & Exceptions(6, 1)

我已经花了将近4天的时间在脑海和Google上搜寻，因此即使您只是在正确的方向上进行微调，也可以向您提供任何帮助。

----编辑---- 我想我可能已经开始弄清楚了，但是出现了“对象不支持该属性或方法”错误，并且不确定如何解决。调试指向If cb.ControlFormat.Value = True。是否建议使用哪种语法在组框中查找复选框的真/假状态？

Set AirCBCap = Worksheets("List_Data").Range("B2") 'Define checkbox caption reference column
Set Air_Ex = Worksheets("List_Data").Range("A2")  'Define brevity code list reference

For Each cb In AirExGroup.Controls
If TypeName(cb) = "CheckBox" Then
    If cb.ControlFormat.Value = True Then
        For i = 0 To 6
            If cb.Caption = AirCBCap.Offset(i, 0).Value Then 'If checked, find offset in caption name list that matches the checkbox caption     
                If AirCode = "" Then
                    AirCode = Air_Ex.Offset(i, 0)  'Find the offset that matches the offset of the checkbox caption and apply that to "AirCode"
                Else
                    AirCode = AirCode & ", " & Air_Ex.Offset(i, 0).Value
                End If
            End If
        Next i
    Else
        AirCode = "N/A" 'If no boxes checked, print "N/A" in exceptions cell
    End If
End If
Next cb 
emptyCell.Offset(0, 13).Value = AirCode

Answer 1

我能够使用For / Next循环使它起作用。这不是很漂亮，因为我确定可以将很多Dims和Set范围组合在一起，使其更优雅，但是它可以按照我想要的方式工作，所以我现在就来介绍。

Dim emptyCell As Range, AirBoxList As Range, TrkBoxList As Range, WhsBoxList As Range, AirCBCap As Range, Air_Ex As Range
Dim TrkCBCap As Range, WhsCBCap As Range, Trk_Ex As Range, Whs_Ex As Range
Dim shtSel As String, AirBoxName As String, AirCode As String, TrkCode As String, TrkBoxName As String, WhsCode As String
Dim WhsBoxName As String
Dim AirExGroup As Frame, TrkExGroup As Frame, WhseExgroup As Frame
Dim i As Integer

shtSel = sheetslistCB.Value

'Make selected sheet active
Worksheets(shtSel).Activate

Set AirExGroup = Me.AirlineExGrp    'Contains all Airline exception checkboxes
Set TrkExGroup = Me.TruckExGrp      'Contains all Trucker exception checkboxes
Set WhseExgroup = Me.WhseExGrp      'Contains all Warehouse exception checkboxes

Set emptyCell = Worksheets(shtSel).Range("A6") 'SelectFirstBlankCell Use function to determine emptyRow
Set AirCBCap = Worksheets("List_Data").Range("B2") 'Define checkbox caption reference column
Set Air_Ex = Worksheets("List_Data").Range("A2")  'Define brevity code list reference
Set AirBoxList = Worksheets("List_Data").Range("M2") 'Define list of names of Air freight check boxes
Set TrkBoxList = Worksheets("List_Data").Range("N2") 'Define list of names of Truck Check Boxes
Set WhsBoxList = Worksheets("List_Data").Range("O2") 'Define list of names of Warehouse check boxes
Set TrkCBCap = Worksheets("List_Data").Range("D2")   'Define checkbox caption reference column (Trucking)
Set WhsCBCap = Worksheets("List_Data").Range("F2")   'Define checkbox caption reference column (Warehouse)
Set Trk_Ex = Worksheets("List_Data").Range("C2")     'Define Brevity code list reference (Trucking)
Set Whs_Ex = Worksheets("List_Data").Range("E2")     'Define Brevity code list reference (Warehouse)

'Airline Exceptions
For i = 0 To 6
    AirBoxName = AirBoxList.Offset(i, 0).Value
    If Me.Controls(AirBoxName).Value = True Then
        If Me.Controls(AirBoxName).Caption = AirCBCap.Offset(i, 0).Value Then
            If AirCode = "" Then
                AirCode = Air_Ex.Offset(i, 0).Value 'Find the offset that matches the offset of the checkbox caption and apply that to "AirCode"
            Else
                AirCode = AirCode & ", " & Air_Ex.Offset(i, 0).Value
            End If
         End If
    End If
Next i
emptyCell.Offset(0, 13).Value = AirCode
'Trucker Exceptions
For i = 0 To 3
    TrkBoxName = TrkBoxList.Offset(i, 0).Value
    If Me.Controls(TrkBoxName).Value = True Then
        If Me.Controls(TrkBoxName).Caption = TrkCBCap.Offset(i, 0).Value Then
            If TrkCode = "" Then
                 TrkCode = Trk_Ex.Offset(i, 0).Value 'Find the offset that matches the offset of the checkbox caption and apply that to "TrkCode"
            Else
                TrkCode = TrkCode & ", " & Trk_Ex.Offset(i, 0).Value
            End If
        End If
    End If
Next i
emptyCell.Offset(0, 14).Value = TrkCode

'Warehouse Exceptions
For i = 0 To 0
    WhsBoxName = WhsBoxList.Offset(i, 0).Value
    If Me.Controls(WhsBoxName).Value = True Then
        If Me.Controls(WhsBoxName).Caption = WhsCBCap.Offset(i, 0).Value Then
            If WhsCode = "" Then
                WhsCode = Whs_Ex.Offset(i, 0).Value 'Find the offset that matches the offset of the checkbox caption and apply that to "WhsCode"
            Else
                WhsCode = WhsCode & ", " & Whs_Ex.Offset(i, 0).Value
            End If
        End If
    End If
Next i
emptyCell.Offset(0, 15).Value = WhsCode

Unload Me

End Sub