VBA遍历指定复选框批量填充多数组的简洁实现方法问询

你需要遍历20个从Checkbox 30到Checkbox 49（共20个）的复选框，将选中状态批量填充到四个不同维度的数组中，其中Checkbox 31对应数组第2行、Checkbox 32对应第3行，以此类推。以下是两种简洁高效的实现方案：

基础优化版 #

通过循环遍历所有复选框，统一计算对应数组的列索引，再逐行填充每个数组：

Sub FillGraphArrays()
    Dim cb As Shape
    Dim colIndex As Integer
    Dim isChecked As Boolean
    Dim i As Integer, row As Integer
    
    ' 初始化目标数组（若未提前定义）
    Dim Graph_1(1 To 2, 1 To 20) As Integer
    Dim Graph_2(1 To 2, 1 To 20) As Integer
    Dim Graph_3(1 To 3, 1 To 20) As Integer
    Dim Graph_4(1 To 6, 1 To 20) As Integer
    
    ' 遍历20个复选框（Checkbox 30至Checkbox 49）
    For i = 30 To 49
        Set cb = ActiveSheet.Shapes("Check Box " & i)
        isChecked = (cb.ControlFormat.Value = 1)
        colIndex = i - 29 ' 计算对应列：Checkbox30→第1列，Checkbox31→第2列…
        
        ' 填充Graph_1
        For row = 1 To 2
            Graph_1(row, colIndex) = IIf(isChecked, 1, 0)
        Next row
        
        ' 填充Graph_2
        For row = 1 To 2
            Graph_2(row, colIndex) = IIf(isChecked, 1, 0)
        Next row
        
        ' 填充Graph_3
        For row = 1 To 3
            Graph_3(row, colIndex) = IIf(isChecked, 1, 0)
        Next row
        
        ' 填充Graph_4
        For row = 1 To 6
            Graph_4(row, colIndex) = IIf(isChecked, 1, 0)
        Next row
    Next i
End Sub

进阶高效版 #

通过集合管理所有数组及其行数，进一步减少重复代码，便于后续扩展：

Sub FillGraphArrays_Advanced()
    Dim cb As Shape
    Dim colIndex As Integer
    Dim isChecked As Boolean
    Dim arrInfo As Collection
    Dim item As Variant
    Dim i As Integer, row As Integer
    
    ' 初始化目标数组
    Dim Graph_1(1 To 2, 1 To 20) As Integer
    Dim Graph_2(1 To 2, 1 To 20) As Integer
    Dim Graph_3(1 To 3, 1 To 20) As Integer
    Dim Graph_4(1 To 6, 1 To 20) As Integer
    
    ' 创建集合存储数组对象与对应行数，方便统一处理
    Set arrInfo = New Collection
    arrInfo.Add Array(Graph_1, 2)
    arrInfo.Add Array(Graph_2, 2)
    arrInfo.Add Array(Graph_3, 3)
    arrInfo.Add Array(Graph_4, 6)
    
    ' 遍历复选框
    For i = 30 To 49
        Set cb = ActiveSheet.Shapes("Check Box " & i)
        isChecked = (cb.ControlFormat.Value = 1)
        colIndex = i - 29
        
        ' 统一处理所有数组的填充逻辑
        For Each item In arrInfo
            Dim targetArr As Variant
            Dim rowCount As Integer
            targetArr = item(0)
            rowCount = item(1)
            
            For row = 1 To rowCount
                targetArr(row, colIndex) = IIf(isChecked, 1, 0)
            Next row
            
            ' 将修改后的数组赋值回原变量（Variant传递为副本，需手动同步）
            Select Case rowCount
                Case 2
                    If targetArr(1, 1) = Graph_1(1, 1) Then Graph_1 = targetArr Else Graph_2 = targetArr
                Case 3
                    Graph_3 = targetArr
                Case 6
                    Graph_4 = targetArr
            End Select
        Next item
    Next i
End Sub

优化说明 #

1. 批量遍历：通过For循环一次性处理所有复选框，避免重复编写20次独立判断逻辑
2. 动态索引：通过colIndex = i - 29自动计算复选框对应的数组列，无需硬编码列号
3. 简化赋值：用IIf函数一行完成选中状态的1/0赋值
4. 可扩展性：进阶版通过集合管理数组，后续新增数组只需在集合中添加条目，无需修改核心填充逻辑

注：若实际需求是遍历Checkbox 30至Checkbox 50（共21个），只需将循环范围改为For i = 30 To 50，并将数组的列数调整为21即可。

内容的提问来源于stack exchange，提问作者Mark Goodhead