VBA实现文本框日期查找及支票数据插入的需求与问题

现有代码仅能在最后一行支票到期日与窗体TextBox3输入日期匹配时，在列表末尾追加数据。需要实现：当日期不同时，查找该日期（不存在则确定插入区间），插入新行并录入数据。

现有代码的问题 #

• 仅对比最后一行的日期，未遍历或查找整个列表的日期
• Else分支无有效插入逻辑，只是重复追加操作
• 直接用TextBox3.Text和单元格值比较，易因日期格式差异导致判断错误

修改后的实现代码 #

Private Sub CommandButton1_Click() ' 假设是录入按钮的点击事件
    Dim ws As Worksheet
    Dim targetDate As Date
    Dim findRange As Range
    Dim insertRow As Long
    
    ' 初始化工作表
    Set ws = ThisWorkbook.Sheets("Çek Programı")
    ' 将输入的日期转为日期类型，避免格式问题
    On Error Resume Next
    targetDate = DateValue(TextBox3.Text)
    On Error GoTo 0
    If IsEmpty(targetDate) Then
        MsgBox "请输入有效的到期日期！"
        Exit Sub
    End If
    
    ' 查找目标日期在C列的位置
    Set findRange = ws.Range("C:C").Find(What:=targetDate, LookIn:=xlValues, LookAt:=xlWhole)
    
    If Not findRange Is Nothing Then
        ' 找到日期，在找到行的下方插入新行
        insertRow = findRange.Row + 1
    Else
        ' 未找到日期，确定插入区间（按日期升序排列）
        On Error Resume Next
        insertRow = Application.Match(targetDate, ws.Range("C:C"), 1) + 1
        On Error GoTo 0
        ' 如果所有日期都小于目标日期，插入到最后一行下方
        If insertRow <= 1 Then
            insertRow = ws.Range("C60").End(xlUp).Row + 1
        End If
    End If
    
    ' 插入新行
    ws.Rows(insertRow).Insert Shift:=xlDown
    
    ' 录入数据到新行
    ws.Range("E" & insertRow).Value = TextBox1.Text
    ws.Range("H" & insertRow).Value = ComboBox1.Text
    ws.Range("F" & insertRow).Value = TextBox2.Text
    ws.Range("C" & insertRow).Value = targetDate
    ws.Range("J" & insertRow).Value = TextBox6.Text
    
    ' 清空窗体控件
    TextBox1.Text = ""
    ComboBox1.Text = ""
    TextBox2.Text = ""
    TextBox3.Text = ""
    TextBox6.Text = ""
End Sub

代码说明 #

• 日期格式处理：将TextBox3的输入转为Date类型，避免因文本格式不一致导致的匹配失败
• 查找目标日期：用Range.Find精准匹配C列的日期，找到则在其下方插入新行
• 确定插入区间：未找到日期时，用Application.Match的近似匹配（1表示查找小于等于目标值的最大值）确定插入位置；若所有日期都小于目标日期，则插入到列表末尾
• 插入并录入数据：插入新行后，将窗体控件的值写入对应单元格，最后清空控件方便下次录入

内容的提问来源于stack exchange，提问作者Emir Gökbudak