查找符合条件的最新值

在Sheet2中

列C（计划ID）可以有多个logging

列K（状态）可以是“批准”或“拒绝”

列L（状态date）

我试图让VBAmacros查看Sheet2中的数据，为每个Plan IDfind最新的“Approved”状态，并将整行数据放入Sheet3中。

我基本上想删除重复，但抓住最后批准的计划。 我认为一些最大date函数会有帮助，但我从来没有使用过。

Answer 1

@ user1274820与他的评论是在正确的轨道上，但我认为你可以让自己更容易。
一个简单的方法（不写macros）将是：

• 复制Sheet2
• 按计划编号>状态（A到Z）>状态date（从最新到最旧）sorting
• 数据>删除重复项（只勾选计划编号）

Answer 2

编辑：更新，以满足新的要求。

正如我在评论中所说，你可以做这样的事情。

这不是世界上最漂亮/最快的代码，但它会完成工作：

Sub GetMostRecentApproved() Application.ScreenUpdating = False Dim OutputSheet, x, OtherID OutputSheet = "Sheet3" 'Clear the OutputSheet Sheets(OutputSheet).Cells.ClearContents 'Copy our data to the output sheet Sheets("Sheet2").UsedRange.Copy Sheets(OutputSheet).Range("A1") 'Sort by Plan ID, Status, Status Date (Oldest to Newest) ActiveWorkbook.Worksheets(OutputSheet).Sort.SortFields.Clear ActiveWorkbook.Worksheets(OutputSheet).Sort.SortFields.Add Key:=Range("C:C"), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal ActiveWorkbook.Worksheets(OutputSheet).Sort.SortFields.Add Key:=Range("K:K"), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal ActiveWorkbook.Worksheets(OutputSheet).Sort.SortFields.Add Key:=Range("L:L"), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With ActiveWorkbook.Worksheets(OutputSheet).Sort .SetRange Sheets(OutputSheet).UsedRange .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With 'x = 2 assumes we have headers 'This pass deletes all non-unique rejected rows With Sheets(OutputSheet) For x = 2 To .UsedRange.Rows.Count If UCase(.Range("K" & x)) = "REJECTED" Then Set OtherID = Union(.Range("C2:C" & x - 1), .Range("C" & x + 1 & ":C" & .UsedRange.Rows.Count)) If Not OtherID.Find(.Range("C" & x).Value, LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then .Range("K" & x).EntireRow.Delete x = x - 1 End If End If Next x For x = 2 To .UsedRange.Rows.Count If .Range("C" & x) = vbNullString Then Exit Sub If .Range("C" & x + 1) = .Range("C" & x) Then .Range("C" & x).EntireRow.Delete x = x - 1 'careful with that iterator eugene End If Next x End With Application.ScreenUpdating = True End Sub 

Sheet2input：

Sheet3输出：