vba - 查找满足条件的最新值

Question

在 Sheet2 中

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

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

L 栏（状态日期）

我正在尝试制作一个 VBA 宏来查看 Sheet2 中的数据，以查找每个计划 ID 的最新“已批准”状态，并将整行数据放入 Sheet3。

我基本上想删除重复项，但是，抓住最后批准的计划。我认为一些 Max Date 功能会有所帮助，但我以前从未使用过它。

Answer 1

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

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

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

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

Sheet2 输入：

Sheet3 输出：

Answer 2

@user1274820 的评论走在了正确的轨道上，但我认为你可以让自己更轻松。
一种简单的方法（无需编写宏）是：

• 复印表2
• 按计划 ID > 状态（A 到 Z）> 状态日期（最新到最旧）排序
• 数据 > 删除重复项（仅选中计划 ID）