按列循环数据：修改VBA代码实现单列填充用户窗体文本框

需求说明 #

原本的VBA代码是从多列循环填充UserForm的连续文本框，现在需要调整逻辑，让每个下拉框选项（Draw）对应单个Excel列，文本框按行顺序依次填充该列的单元格内容：

• Draw 1：TxtBox1=B5、TxtBox2=B6、TxtBox3=B7……
• Draw 2：TxtBox1=C5、TxtBox2=C6、TxtBox3=C7……

修改后的完整代码 #

Option Explicit

Dim ws As Worksheet
Dim tbCounter As Long
Dim targetCol As String
Dim DrawToColDict As Object

Private Sub userForm_Initialize()
    Set ws = Sheets("Sheet1")
    ' 初始化下拉框选项（若已手动添加可忽略）
    With Me.cboDrawNumber
        .Clear
        .AddItem "Draw 1"
        .AddItem "Draw 2"
    End With
End Sub

Private Sub cmdCallResult_Click()
    Set DrawToColDict = CreateObject("Scripting.Dictionary")
    
    ' 建立Draw与目标列的映射，每个Draw对应单个列标识
    With DrawToColDict
        .Add "Draw 1", "B"
        .Add "Draw 2", "C"
        ' 可按需添加更多Draw与对应列
    End With
    
    ' 获取当前选中Draw对应的目标列
    targetCol = DrawToColDict(Me.cboDrawNumber.Value)
    
    ' 重置文本框计数器
    tbCounter = 1
    
    ' 按行遍历填充文本框，行号范围可按需调整
    Dim lngRowLoop As Long
    For lngRowLoop = 5 To 14
        ' 检查文本框是否存在，避免报错
        If Me.Controls.Exists("txtBox" & tbCounter) Then
            Me.Controls("txtBox" & tbCounter).Text = ws.Cells(lngRowLoop, targetCol).Text
            tbCounter = tbCounter + 1
        Else
            ' 无更多文本框时退出循环
            Exit For
        End If
    Next lngRowLoop
End Sub

关键修改点 #

• 字典映射调整：将原字典中每个Draw对应的多列数组，改为单个列标识，简化映射关系。
• 循环逻辑重构：去掉原有的列循环，改为仅遍历目标列的行，依次对应文本框序号，实现单列逐行填充。
• 增加存在性检查：添加Controls.Exists判断，避免因文本框数量不足导致运行时错误。
• 可选下拉框初始化：在userForm_Initialize中添加下拉框选项初始化代码，确保下拉框有可选值（若已手动添加可忽略）。

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