查找满足条件的最新值答案

【问题标题】：Find most recent value that meets a condition查找满足条件的最新值
【发布时间】：2015-05-21 14:51:17
【问题描述】：

在 Sheet2 中

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

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

L 列（状态日期）

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

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

【问题讨论】：

我可能会按计划 ID、状态和状态日期（从最旧到最新）对其进行排序 - 删除列出的所有拒绝行 - 并在计划 ID 更改时获取每个批准日期的页面跨度>

标签： vba date excel maxdate

【解决方案1】：

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

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

【讨论】：

我正在尝试排序和删除方法，但我遗漏了两个细节：首先是一个计划可以有一个最近的记录被拒绝，而过去的记录被批准（我想要批准一个被拉）。同样，如果一个计划只有一个被拒绝的记录，我想要那个。
好的，我可以假设您需要为这个新需求编辑代码吗？
编辑了答案以更好地适应新要求，尝试新步骤。
这是我尝试过的方法之一，但问题是如果最近的记录被拒绝，但有一个比它更旧的记录被批准，则批准的记录将被删除，但我想获得批准的记录。如果它是该计划的唯一记录，我只想要被拒绝的记录。
我现在明白了！！！非常感谢您的帮助！我现在正在更新它，如果我挂断电话，我会通知你。感谢您抽出时间帮助陌生人！

【解决方案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

Sheet2 输入：

Sheet3 输出：

【讨论】：