循环遍历文本框的二维数组

Question

我有一个包含 100 个文本框的用户表单。它们排列成 10 x 10 阵列。文本框有名字

C1_A1  to C1_A10 (first row)
C2_A1  to C2_A10 (second row)
..... 
C10_A1  to C10_A10 (tenth row)

如何逐行遍历文本框。 textbox_change() 的代码如下所示。我成功地为一个包含 10 个盒子的表单实现了这一点。但是现在我必须缩放到一个有 100 个盒子的表格，这不再实用。

Private Sub C1_A1_Change()
    Dim wt As Double 
    C1_A1.SetFocus
    If IsNumeric(C1_A1.Value) Then
        wt = CDbl(C1_A1.Value)
        If wt >= 0 And wt <= 1 Then
            'do nothing
        Else
            MsgBox "Enter a number between 0 and 1"
            C1_A1.Value = vbNullString
        End If 
    Else
        wt = 0 
    End If
End Sub


'an action button to read all values 
Private Sub ReadDataTT1_Click()
    Me.C1_A1.Value = Range("Wt!E9").Value
    ............
    Me.C10_A10.Value = Range("Wt!N18").Value
End Sub 


'an action button to save all values  
Private Sub SaveDataTT1_Click()      
    If C1A1.Value <> "" Then
        Range("Wt!E9").Value = C1_A1.Value
        ............  
        Range("Wt!N18").Value = C10_A10.Value
    End If  
End Sub

Answer 1

要对所有文本框仅使用一个事件处理程序 (TextBox_Change Event)，您可以使用类模块。

1. 添加一个名为clsTextBox的类模块，内容如下：

   Option Explicit
   
   Public WithEvents pTbx As MSForms.TextBox
   
   Private Sub pTbx_Change()
       Dim wt As Double
   
       If IsNumeric(pTbx.Value) Then
           wt = CDbl(pTbx.Value)
           If wt >= 0 And wt <= 1 Then
               'do nothing
           Else
               MsgBox "Enter a number between 0 and 1"
               pTbx.Value = vbNullString
           End If
       Else
           wt = 0
       End If
   End Sub
   

   请注意，这是您在 TextBox_Change 事件中使用的代码，我们希望将其应用于所有文本框。

2. 将以下内容添加到您的用户表单以将类应用于您的文本框

   Option Explicit
   
   Private mArrClsTbx(1 To 9) As clsTextBox   'change 9 to number of textboxes
   
   Const TbxRows As Long = 3   'change 3 to number of text box rows
   Const TbxCols As Long = 3   'change 3 to number of text box columns
   
   Private Sub UserForm_Initialize()
       Dim i As Long
   
       Dim iRow As Long, iCol As Long
       For iRow = 1 To TbxRows
           For iCol = 1 To TbxCols
               i = i + 1
               Set mArrClsTbx(i) = New clsTextBox
               Set mArrClsTbx(i).pTbx = Controls("C" & iRow & "_A" & iCol)
           Next iCol
       Next iRow
   End Sub
   

3. 要读取/保存值，您可以使用类似于上述写入/读取单元格的循环，而不是两个 Set 行。

   Public Sub WriteDataToWorksheet()
       Dim iRow As Long, iCol As Long
       For iRow = 1 To TbxRows
           For iCol = 1 To TbxCols
               Worksheets("Wt").Range("E9").Offset(iRow - 1, iCol - 1).Value = Controls("C" & iRow & "_A" & iCol).Value
           Next iCol
       Next iRow
   End Sub
   
   Public Sub ReadDataFromWorksheet()
       Dim iRow As Long, iCol As Long
       For iRow = 1 To TbxRows
           For iCol = 1 To TbxCols
               Controls("C" & iRow & "_A" & iCol).Value = Worksheets("Wt").Range("E9").Offset(iRow - 1, iCol - 1).Value
           Next iCol
       Next iRow
   End Sub