Excel用户窗体TextBox按日期匹配列写入单元格的VBA实现问题

完整修改代码 #

Private Sub cmdRun_Click()
    Dim ws As Worksheet
    Dim targetCol As Long
    Dim todayDay As Integer
    Dim ctrlPairs As Variant
    Dim i As Integer
    
    ' 指定目标工作表，替换为你实际的表名（比如"Sheet1"）
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    ' 获取今日的日数（例：15号返回15）
    todayDay = Day(Date)
    
    ' 在第二行查找对应今日日期的列
    ' 注意：如果第二行存的是数字1、2、3...（而非完整日期），把Date替换为todayDay
    On Error Resume Next
    targetCol = Application.Match(Date, ws.Rows(2), 0)
    On Error GoTo 0
    
    ' 检查是否找到目标列
    If targetCol = 0 Then
        MsgBox "未找到今日日期对应的列，请检查第二行的日期设置！"
        Exit Sub
    End If
    
    ' 绑定文本框与目标行号，减少重复代码
    ctrlPairs = Array( _
        Me.txtImpl, 4, _
        Me.txtOrga, 5, _
        Me.txtTime, 6, _
        Me.txtFocu, 7, _
        Me.txtRest, 8, _
        Me.txtFrus, 9 _
    )
    
    ' 循环处理输入验证与数据写入
    For i = LBound(ctrlPairs) To UBound(ctrlPairs) Step 2
        If Trim(ctrlPairs(i).Text) = "" Then
            MsgBox "Error, " & GetCtrlLabel(ctrlPairs(i)) & " can't be empty"
            ctrlPairs(i).SetFocus ' 定位到空输入框，方便补填
            Exit Sub
        End If
        ws.Cells(ctrlPairs(i + 1), targetCol).Value = ctrlPairs(i).Text
    Next i
    
    MsgBox "数据已成功写入！"
End Sub

' 辅助函数：返回文本框对应的提示名称
Private Function GetCtrlLabel(ctrl As Control) As String
    Select Case ctrl.Name
        Case "txtImpl": GetCtrlLabel = "Impulsiveness"
        Case "txtOrga": GetCtrlLabel = "Organization"
        Case "txtTime": GetCtrlLabel = "Time Managment"
        Case "txtFocu": GetCtrlLabel = "Focus"
        Case "txtRest": GetCtrlLabel = "Restlessness"
        Case "txtFrus": GetCtrlLabel = "Frustration"
    End Select
End Function

Private Sub cmdClos_Click()
    Unload Me ' 关闭用户窗体
End Sub

关键修改说明 #

1. 动态列定位

   • 用Application.Match在工作表第二行查找今日日期，返回对应列号。如果第二行存储的是数字1、2、3...（而非完整日期值），把代码里的Date替换为todayDay即可。
   • 增加错误判断，找不到对应列时直接提示并退出，避免程序崩溃。

2. 代码精简优化

   • 用数组批量绑定文本框和目标行号，通过循环完成所有输入验证与数据写入，避免重复编写6段几乎相同的代码，后续修改更方便。
   • 加入Trim()过滤输入空格，防止用户输入空格被误判为有效内容；空值提示后自动定位到对应输入框，提升操作体验。

3. 关闭按钮实现

   • cmdClos按钮直接用Unload Me即可关闭当前用户窗体，逻辑简单直接。

新手注意事项 #

• 必须替换代码中的工作表名称（"Sheet1"）为你实际使用的工作表名称。
• 确保第二行的日期是标准日期值（不是文本格式），否则Match函数无法匹配成功。可以选中第二行日期单元格，在Excel菜单栏的「开始」选项卡中设置单元格格式为「日期」。
• 测试时可以手动修改第二行的日期，验证列定位是否准确。

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