VBA代码报错求助：实现日期匹配自动填充“Create”功能

我先理清楚你的需求：J列存储了一组日期，你会手动在B3到K3的单元格中填写部分日期；当J列某一行的日期，和B3:K3里有内容的单元格的日期匹配时，自动在该行的H列填入"Create"。针对这个需求，我帮你修正了代码，还加了一些实用的优化：

Sub NDate_Inp()
    Dim ws As Worksheet
    Dim jLastRow As Long
    Dim i As Long, k As Long
    Dim targetDate As Date
    
    ' 指定要操作的工作表，这里用当前激活的工作表，你可以改成Sheet1这类名称
    Set ws = ActiveSheet
    
    ' 关闭屏幕更新，提升运行速度，避免闪烁
    Application.ScreenUpdating = False
    
    ' 先清空H列的旧结果，防止残留
    ws.Range("H:H").ClearContents
    
    ' 找到J列最后一行有数据的行号，避免硬编码行数
    jLastRow = ws.Cells(ws.Rows.Count, "J").End(xlUp).Row
    
    ' 遍历J列的每一行（从第2行开始，假设第1行是表头）
    For i = 2 To jLastRow
        ' 跳过J列空单元格或非日期内容
        If Not IsEmpty(ws.Cells(i, "J")) And IsDate(ws.Cells(i, "J")) Then
            targetDate = ws.Cells(i, "J").Value
            
            ' 遍历B3到K3的每个单元格（B是第2列，K是第11列）
            For k = 2 To 11
                ' 检查当前单元格是否有内容、是日期，并且和J列日期匹配
                If Not IsEmpty(ws.Cells(3, k)) And IsDate(ws.Cells(3, k)) Then
                    If ws.Cells(3, k).Value = targetDate Then
                        ws.Cells(i, "H").Value = "Create"
                        Exit For ' 找到匹配就退出内层循环，减少不必要的遍历
                    End If
                End If
            Next k
        End If
    Next i
    
    ' 恢复屏幕更新
    Application.ScreenUpdating = True
    
    MsgBox "匹配完成！", vbInformation
End Sub

代码关键点说明 #

• 工作表指定：用ActiveSheet表示当前激活的表格，如果你需要固定操作某个工作表，可以改成Set ws = ThisWorkbook.Sheets("你的工作表名称")
• 日期有效性检查：加入IsDate函数，避免非日期内容干扰匹配逻辑，防止报错
• 效率优化：关闭ScreenUpdating减少运行时的屏幕闪烁，找到匹配后用Exit For跳出内层循环，减少不必要的遍历
• 空值处理：跳过J列和B3:K3中的空单元格，避免空值导致的逻辑错误

你可以直接把这段代码替换你原来的片段，然后运行测试。如果你的表头不是第1行，或者需要调整匹配范围，直接修改循环的起始行/列号就行。

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