问题拆解与错误分析 #

先理清楚你的核心需求：为每一行的返工日期（I列），找到对应相同序列号（H列=E列）、且不晚于该返工日期的最近（最大）装配日期（G列），结果写入L列。

你当前代码出现类型不匹配错误，主要是这几个坑导致的：

• 行号未重置：外层循环j每次迭代时，变量x没有重置为初始值，循环到后面x会超出你的数据范围（比如你硬编码了12行），Cells(x,7)可能是空值或非日期内容，DateValue无法解析就报错了。
• 固定行引用错误：你代码里用Cells(1,9)取返工日期、Cells(1,8)取返工序列号，这是固定引用第1行数据，完全没对应到当前j所在行的返工记录，逻辑完全跑偏。
• 最大值逻辑缺失：你没有初始化MaxDate，也没做“取更大值”的判断，只会保留最后一个符合条件的日期，而不是真正的最近日期。

修正后的VBA代码 #

下面是调整后的代码，解决了上述问题，逻辑更严谨也更灵活：

Sub GetRecentAssemblyDate()
    Dim reworkRow As Long ' 返工行号
    Dim assemRow As Long ' 装配行号
    Dim reworkSerial As String ' 当前返工序列号
    Dim reworkDateTime As Double ' 当前返工日期时间（转数值方便比较）
    Dim maxAssemDateTime As Double ' 符合条件的最大装配日期时间
    Dim lastReworkRow As Long ' 返工数据最后一行
    Dim lastAssemRow As Long ' 装配数据最后一行
    
    ' 动态获取数据最后一行，不用硬编码行号，适配数据增减
    lastReworkRow = Cells(Rows.Count, "I").End(xlUp).Row
    lastAssemRow = Cells(Rows.Count, "G").End(xlUp).Row
    
    ' 遍历每一行返工数据
    For reworkRow = 1 To lastReworkRow
        ' 获取当前返工的序列号和日期时间（转数值避免格式解析问题）
        reworkSerial = Cells(reworkRow, "H").Value
        reworkDateTime = CDbl(Cells(reworkRow, "I").Value)
        
        ' 初始化最大装配日期为极小值，确保第一个符合条件的日期能被选中
        maxAssemDateTime = 0
        
        ' 遍历所有装配数据，找匹配的最大日期
        For assemRow = 1 To lastAssemRow
            ' 检查序列号匹配，且装配日期不晚于返工日期
            If Cells(assemRow, "E").Value = reworkSerial And CDbl(Cells(assemRow, "G").Value) <= reworkDateTime Then
                ' 如果当前装配日期更大，更新最大值
                If CDbl(Cells(assemRow, "G").Value) > maxAssemDateTime Then
                    maxAssemDateTime = CDbl(Cells(assemRow, "G").Value)
                End If
            End If
        Next assemRow
        
        ' 将结果写入L列，没找到匹配项则留空
        If maxAssemDateTime > 0 Then
            Cells(reworkRow, "L").Value = CDate(maxAssemDateTime)
            ' 同步原日期格式，保证显示一致
            Cells(reworkRow, "L").NumberFormat = Cells(reworkRow, "G").NumberFormat
        Else
            Cells(reworkRow, "L").Value = ""
        End If
    Next reworkRow
    
    MsgBox "匹配完成！", vbInformation
End Sub

代码亮点说明 #

• 动态适配数据：用End(xlUp)自动获取最后一行，不用手动改代码里的行号，数据增减都能适配。
• 数值化日期比较：把日期时间转为Double类型数值，比拆分Date/Time更可靠，避免格式解析错误。
• 严谨的最大值逻辑：初始化maxAssemDateTime为0，确保第一个符合条件的日期会被选中，每次找到更大的符合条件日期就更新最大值。
• 友好的异常处理：没有匹配到序列号或符合条件的日期时，L列会留空，不会出现错误值。

大数据量优化方案 #

如果你的数据有上千行，嵌套循环会比较慢，可以用**字典（Dictionary）**先分组存储序列号对应的装配日期，再快速查找，效率提升明显：

Sub GetRecentAssemblyDate_Fast()
    Dim serialDict As Object
    Dim reworkRow As Long, assemRow As Long
    Dim reworkSerial As String, reworkDateTime As Double
    Dim assemDates As Variant, maxDate As Double
    Dim lastReworkRow As Long, lastAssemRow As Long
    
    Set serialDict = CreateObject("Scripting.Dictionary")
    
    ' 获取数据最后一行
    lastAssemRow = Cells(Rows.Count, "G").End(xlUp).Row
    lastReworkRow = Cells(Rows.Count, "I").End(xlUp).Row
    
    ' 先把所有装配数据按序列号分组，存储对应的日期数组
    For assemRow = 1 To lastAssemRow
        reworkSerial = Cells(assemRow, "E").Value
        If Not serialDict.Exists(reworkSerial) Then
            ' 首次遇到该序列号，创建数组
            serialDict(reworkSerial) = Array(CDbl(Cells(assemRow, "G").Value))
        Else
            ' 追加日期到数组
            assemDates = serialDict(reworkSerial)
            ReDim Preserve assemDates(UBound(assemDates) + 1)
            assemDates(UBound(assemDates)) = CDbl(Cells(assemRow, "G").Value)
            serialDict(reworkSerial) = assemDates
        End If
    Next assemRow
    
    ' 遍历返工数据，快速查找最大日期
    For reworkRow = 1 To lastReworkRow
        reworkSerial = Cells(reworkRow, "H").Value
        reworkDateTime = CDbl(Cells(reworkRow, "I").Value)
        maxDate = 0
        
        If serialDict.Exists(reworkSerial) Then
            assemDates = serialDict(reworkSerial)
            ' 遍历该序列号的所有装配日期，找不超过返工日期的最大值
            For Each dateVal In assemDates
                If dateVal <= reworkDateTime And dateVal > maxDate Then
                    maxDate = dateVal
                End If
            Next dateVal
        End If
        
        ' 写入结果
        If maxDate > 0 Then
            Cells(reworkRow, "L").Value = CDate(maxDate)
            Cells(reworkRow, "L").NumberFormat = Cells(reworkRow, "G").NumberFormat
        Else
            Cells(reworkRow, "L").Value = ""
        End If
    Next reworkRow
    
    MsgBox "快速匹配完成！", vbInformation
End Sub

这个版本先把每个序列号的装配日期都存在字典里，后续查找时不用再遍历整个装配列，数据量大的时候速度会快很多。

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