比较日期然后匹配列

Question

Sheet1 全年累积工作并提供建议。

Sheet2 累积已完成的推荐。

Sheet1 上任何没有匹配的行都需要跟进。重复项在第 14 行突出显示。由于第 14 行的作业发生在 2019 年 1 月 24 日，因此无法在该日期之前完成建议。

这是我用于 MatchColums 的代码；

Sub MatchColums()

Dim i, total, fRow As Integer
Dim found As Range

total = Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row

For i = 1 To total
    answer1 = Worksheets(1).Range("C" & i).Value
    Set found = Worksheets(2).Columns("C:C").Find(what:=answer1) 'finds a match

    If found Is Nothing Then
        Worksheets(1).Range("H" & i).Value = "NO MATCH"
    Else
        fRow = Sheets(2).Columns("C:C").Find(what:=answer1).Row
        Worksheets(1).Range("I" & i).Value = Worksheets(2).Range("A" & fRow).Value
        Worksheets(1).Range("J" & i).Value = Worksheets(2).Range("B" & fRow).Value
        Worksheets(1).Range("K" & i).Value = Worksheets(2).Range("C" & fRow).Value
        Worksheets(1).Range("L" & i).Value = Worksheets(2).Range("D" & fRow).Value
        Worksheets(1).Range("M" & i).Value = Worksheets(2).Range("E" & fRow).Value
        Worksheets(1).Range("N" & i).Value = Worksheets(2).Range("F" & fRow).Value
        Worksheets(1).Range("O" & i).Value = Worksheets(2).Range("G" & fRow).Value

     End If
 Next i

End Sub

为了防止重复，我添加了以下代码；

Sub CompareDates()

If Sheet1.Range("A1") < Sheet2.Range("A1") Then
    Run "MatchColums"
End If
End Sub

我没有收到任何错误消息，但我的 CompareDates 宏似乎不起作用。我尝试先运行 matchcolums 宏，但再次得到以下相同的结果；

这是 Sheet2 的副本

Answer 1

这两行做同样的事情

Dim i, total, fRow As Integer 

Dim i As Variant, total As Variant, fRow As Integer

• 以Integer 为Dim

  Dim i As Integer, total As Integer, fRow As Integer

---

这看起来总是评估为“1”，除非Column A 有空单元格，那么您的For 循环功能如何

`total = Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row`

---

Find 只返回第一个匹配项

`Set found = Worksheets(2).Columns("C:C").Find(what:=answer1)`

• 您似乎不是在搜索唯一值。您的示例数据在 Column C 中具有“姓氏”，而“Moss”在 Shhet1 中出现的时间不同，但您的 Find 函数只会返回 Sheet2 中第一次出现的“Moss”。这意味着Sheet2 中的第一个“Moss”将为Sheet1 中的每个“Moss”写入。所以你得到误报和错误的匹配。这在您的输出中很明显，您没有提供Sheet2 的样本，但我知道“Moss”的第一次出现是“2018 年 12 月 18 日”上的“工作编号 13774”，因为它在 @ 中多次写入987654337@。要解决此问题，请使用具有唯一值的 Find 或查找每个匹配项并比较日期、工作编号等，直到找到正确的值。

• 您已将范围限定为工作表级别，但 Rows.Count 不合格。

---

这个块可以缩短为一行

`Worksheets(1).Range("I" & i).Value = Worksheets(2).Range("A" & fRow).Value`
`Worksheets(1).Range("J" & i).Value = Worksheets(2).Range("B" & fRow).Value`
`Worksheets(1).Range("K" & i).Value = Worksheets(2).Range("C" & fRow).Value`
`Worksheets(1).Range("L" & i).Value = Worksheets(2).Range("D" & fRow).Value`
`Worksheets(1).Range("M" & i).Value = Worksheets(2).Range("E" & fRow).Value`
`Worksheets(1).Range("N" & i).Value = Worksheets(2).Range("F" & fRow).Value`
`Worksheets(1).Range("O" & i).Value = Worksheets(2).Range("G" & fRow).Value`

Worksheets(1).Range("I" & i ":O" & i) = Worksheets(2).Range("A" & fRow & ":G" & fRow)