VBA用户表单日期匹配数据提交异常及功能实现需求

原代码的核心问题 #

1. 逻辑完全颠倒：需求是「未找到日期则新增行」，但原代码写的是If Not IsError(lastRow)——也就是找到日期时才执行新增操作，完全反了。
2. Match返回值处理错误：Application.Match返回的是查找区域（G5:G）内的相对位置，不是工作表的绝对行号，直接赋值给lastRow会导致行号计算错误。
3. 日期类型不匹配：TextBox1输入的是文本格式，若G列是日期格式，直接用文本匹配会找不到对应日期。
4. 错误处理不规范：启用On Error Resume Next后未恢复默认错误处理，可能掩盖其他代码异常。

修正后的完整代码 #

Private Sub CommandButton1_Click()
    Dim targetsheet As String
    targetsheet = ComboBox1.Value
    
    ' 未选择工作表则退出
    If targetsheet = "" Then
        MsgBox "请先选择目标工作表"
        Exit Sub
    End If

    Dim ws As Worksheet
    Set ws = Worksheets(targetsheet)
    Dim lookupDate As Date
    Dim matchPos As Variant ' 用Variant接收Match结果，兼容错误值
    Dim newRow As Long
    Dim SalesClm As Integer, IvfClm As Integer, MomoClm As Integer

    ' 处理日期输入，转换为日期类型避免匹配失败
    On Error GoTo DateError
    lookupDate = CDate(Me.TextBox1.Value)
    On Error GoTo 0 ' 恢复默认错误处理

    ' 在G列第5行开始查找日期
    matchPos = Application.Match(CLng(lookupDate), ws.Range("G5:G"), 0)

    SalesClm = 2
    IvfClm = 3
    MomoClm = 4

    ' 未找到日期时执行新增操作
    If IsError(matchPos) Then
        ' 找到G列最后一行的下一行作为新行
        newRow = ws.Cells(ws.Rows.Count, "G").End(xlUp).Row + 1
        
        ' 填充日期到G列
        ws.Cells(newRow, "G").Value = lookupDate
        
        ' 填充各TextBox数据到对应列
        If Me.TextBox2 <> "" Then ws.Cells(newRow, SalesClm) = Me.TextBox2.Value
        If Me.TextBox3 <> "" Then ws.Cells(newRow, IvfClm) = Me.TextBox3.Value
        If Me.TextBox4 <> "" Then ws.Cells(newRow, MomoClm) = Me.TextBox4.Value

        If Me.TextBox5 <> "" Then ws.Cells(newRow, SalesClm + 3) = Me.TextBox5.Value
        If Me.TextBox6 <> "" Then ws.Cells(newRow, IvfClm + 3) = Me.TextBox6.Value
        If Me.TextBox7 <> "" Then ws.Cells(newRow, MomoClm + 3) = Me.TextBox7.Value

        If Me.TextBox8 <> "" Then ws.Cells(newRow, SalesClm + 6) = Me.TextBox8.Value
        If Me.TextBox9 <> "" Then ws.Cells(newRow, IvfClm + 6) = Me.TextBox9.Value
        If Me.TextBox10 <> "" Then ws.Cells(newRow, MomoClm + 6) = Me.TextBox10.Value
        
        MsgBox "数据添加成功"
        
        ' 清空输入框
        With Me
            .TextBox1.Value = ""
            .TextBox2.Value = ""
            .TextBox3.Value = ""
            .TextBox4.Value = ""
            .TextBox5.Value = ""
            .TextBox6.Value = ""
            .TextBox7.Value = ""
            .TextBox8.Value = ""
            .TextBox9.Value = ""
            .TextBox10.Value = ""
        End With
    Else
        MsgBox "该日期已存在，无需重复添加"
    End If
    
    Exit Sub
DateError:
    MsgBox "请输入有效的日期格式"
    Me.TextBox1.SetFocus
End Sub

Private Sub CommandButton2_Click()
    Unload Me
End Sub

Private Sub UserForm_Initialize()
    Dim sh As Worksheet
    ComboBox1.Clear
    
    ' 填充工作表名称到下拉框
    For Each sh In ThisWorkbook.Worksheets
        ComboBox1.AddItem sh.Name
    Next sh
End Sub

关键修改说明 #

• 修正核心逻辑：改为If IsError(matchPos)判断未找到日期的情况，才执行新增操作
• 日期类型转换：将TextBox1的输入转为日期类型，并用CLng()匹配（解决日期格式不同导致的匹配失败）
• 错误处理优化：新增日期输入错误的捕获分支，恢复默认错误处理避免隐藏异常
• 行号计算修正：直接取G列最后一行的下一行作为新行，逻辑更清晰
• 新增日期填充：原代码漏了将TextBox1的日期填入G列，修正后补充了这一步
• 友好提示：增加未选工作表、日期无效、日期已存在的提示信息，提升用户体验

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