遍历二维文本框数组

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 事件），您可以使用 class 模块。

添加名为 clsTextBox 的 class 模块，内容如下：

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 活动中使用的代码，我们希望将其应用于所有文本框。

将以下内容添加到您的用户表单以将 class 应用到您的文本框

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

到 read/save 值，您可以使用类似于上面 writing/reading 单元格的循环而不是两个 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

遍历二维文本框数组

Looping through a 2D array of text boxes

excel

vba

textbox

loops