Question

我有以下问题：我尝试过滤工作表（HISTORICALS）中的日期列（A）以返回最高和第二高的日期值。目前，本专栏的日期范围为12月25日至31日。不幸的是，下面的公式（使用大函数）返回第31次（而不是预期的第30和第31）。

Sub Select_Last_Two_Days()

    With Worksheets("HISTORICALS")
        Highest_Max = Format(WorksheetFunction.Large(Worksheets("HISTORICALS").Range("A:A"), 1), "Short Date")
        Second_Highest_Max = Format(WorksheetFunction.Large(Worksheets("HISTORICALS").Range("A:A"), 2), "Short Date")
        Debug.Print Highest_Max, Second_Highest_Max
    End With

End Sub

该列有约。 2000行，日期多次出现。理想情况下，我希望过滤不同的值，然后返回两个最高日期。知道我该怎么做吗？

Answer 1

简单地将Barry Houdinis的回答从How to find the first and second maximum number?翻译成VBA：

Sub Select_Last_Two_Days()

    With Worksheets("HISTORICALS")
        Highest_Max = Format(WorksheetFunction.Max(.Range("A:A")), "Short Date")
        Second_Highest_Max = Format(WorksheetFunction.Large(.Range("A:A"), WorksheetFunction.CountIf(.Range("A:A"), WorksheetFunction.Max(.Range("A:A"))) + 1), "Short Date")
        Debug.Print Highest_Max, Second_Highest_Max
    End With

End Sub

Answer 2

评论中给出的建议可能是最简单，最少量的代码方式，但这是另一个建议：

Sub test()

Dim wb As Workbook
Dim ws As Worksheet

Set wb = ThisWorkbook
Set ws = wb.Worksheets("HISTORICALS")

Dim lastRow As Long

lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

Dim loopArr()

loopArr = ws.Range("A1:A" & lastRow).Value

Dim maxVal As Date

maxVal = Application.WorksheetFunction.Large(ws.Range("A1:A" & lastRow), 1)

Dim i As Long
Dim secondVal As Date

   For i = UBound(loopArr, 1) To LBound(loopArr, 1) Step -1

        If loopArr(i, 1) < maxVal Then
          secondVal = loopArr(i, 1)
          Exit For
        End If
   Next i

End Sub

VBA：找到第二大价值

2 个答案: