返回最大日期的第一行号

问题描述 投票:0回答:4

如何编写 VBA 以返回 L 列中找到的第一行号作为该列中的最大日期?

我正在尝试这段代码并得到

“未设置对象变量或 With 块变量”

Sub FindMaxValRow()
Dim Rng As Range
Dim MaxCell As Range
Dim MaxVal As Long

Set Rng = Range("L1:L500")
MaxVal = WorksheetFunction.Max(Rng)
Set MaxCell = Rng.find(what:=MaxVal, LookIn:=xlValues)
MsgBox "Maximum value found at row " & MaxCell.Row
End Sub
excel vba range
4个回答
0
投票

用公式来说就是

=MATCH(MAX(L:L),L:L,0)

如果你想在VBA中计算它,那么你可以使用Evaluate方法:

evaluate("=MATCH(MAX(L:L),L:L,0)") 

0
投票

日期格式、本地数字格式和 VBA 的查找方法存在一个古老的问题,当您在单元格中看到其他内容而不是真正存储的值时,这些问题源于对值的比较。 不要问为什么,但这段代码可以工作

Set MaxCell = Rng.find(what:=CDate(MaxVal), LookIn:=xlFormulas)

在这种情况下,显示的日期实例并不重要。


0
投票

识别日期第一次出现的行

  • L
    有日期(和空单元格)
  • M
    在第二行复制了公式
    =L2
    (为测试添加)
  • N
    在第二行有溢出公式
    =L2:L10
    (为测试添加)

应用程序与工作表功能

如果范围内存在错误值,

Max
(例如
Sum
...)功能将失败。如果未找到匹配项,
Match
(或例如
VLookup
)函数也会如此。如果您使用他们的早期绑定 (
WorksheetFunction
) 版本,则会发生运行时错误。为了避免这种情况,您应该使用它们的后期绑定 (
Application
) 版本,以便能够使用
IsNumeric
IsError
函数测试其结果。

匹配

  • 当您在单列范围内查找第一个(在本例中为最上面)值时,您应该使用更高效的
    Find
    函数,而不是
    Application.Match
    方法。
  • 要匹配的值不能是日期。由于值(日期)被写入变体变量,因此它被识别为整数(整数),更准确地说,就 VBA 数据类型而言,它是一个Double。添加
    CLng
    只是为了强调这一点。
  • 这适用于值、公式和溢出公式。
Sub IdentifyRowOfMaxDateMATCH()
    Const PROC_TITLE As String = "Identify Row of Max Date Using 'Match'"
    
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    Dim rg As Range: Set rg = ws.Range("L2:L500")
    
    Dim MaxValue As Variant: MaxValue = Application.Max(rg)
    
    If IsError(MaxValue) Then
        MsgBox "Found error values in range """ & rg.Address(0, 0) & """.", _
            vbCritical, PROC_TITLE
        Exit Sub
    End If
    
    Dim RowIndex: RowIndex = Application.Match(CLng(MaxValue), rg, 0)
    
    Dim maxCell As Range:
    If IsNumeric(RowIndex) Then
        Set maxCell = rg.Cells(RowIndex)
    End If
    
    If maxCell Is Nothing Then
        MsgBox "Maximum date """ & CDate(MaxValue) & """ not found.", _
            vbCritical, PROC_TITLE
    Else
        MsgBox "Maximum date """ & CDate(MaxValue) _
            & """ found in (worksheet) row " & maxCell.Row & ".", _
            vbInformation, PROC_TITLE
    End If

End Sub

查找

  • 如果您坚持使用

    Find
    方法,则需要将值转换为具有以下模式的字符串:

    "mm\/dd\/yyyy"
    

    使用

    \/
    分隔符,使其与区域设置无关。

  • 这适用于值、公式和溢出公式。

Sub IdentifyRowOfMaxDateFIND()
    Const PROC_TITLE As String = "Identify Row of Max Date Using 'Find'"
    
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    Dim rg As Range: Set rg = ws.Range("L2:L500")
    
    Dim MaxValue As Variant: MaxValue = Application.Max(rg)
    
    If IsError(MaxValue) Then
        MsgBox "Found error values in range """ & rg.Address(0, 0) & """.", _
            vbCritical, PROC_TITLE
        Exit Sub
    End If
    
    Dim MaxDateString As String:
    MaxDateString = Format(MaxValue, "mm\/dd\/yyyy")
    
    Dim maxCell As Range:
    Set maxCell = rg.Find(What:=MaxDateString, _
        After:=rg.Cells(rg.Cells.Count), LookIn:=xlValues, LookAt:=xlWhole)

    If maxCell Is Nothing Then
        MsgBox "Maximum date """ & CDate(MaxDate) & """ not found.", _
           vbCritical, PROC_TITLE
    Else
        MsgBox "Maximum date """ & CDate(MaxDate) _
            & """ found in (worksheet) row " & maxCell.Row & ".", _
            vbInformation, PROC_TITLE
    End If

End Sub

匹配与查找

  • Match
    Find
    更高效(更快)。
  • 查看屏幕截图,无论如何,
    Match
    都会识别第6行,即即使第6行被隐藏或使用
    AutoFilter
    隐藏。如果您将
    Find
    与日期和
    xlFormulas
    (请参阅下面的测试)一起使用,也会发生同样的情况,但只有在单元格包含值时才能使用它。
  • 另一方面,如果第 6 行被
    AutoFilter
    隐藏或隐藏,
    Find
    以及格式化为字符串 (
    MaxDateString
    ) 和
    xlValues
    的值将识别第 8 行(参见上文和下文)。

测试

Sub FindDateTest()
    
    Dim Ins(): Ins = VBA.Array(xlValues, xlFormulas, xlFormulas2)
    Dim Ats(): Ats = VBA.Array(xlWhole, xlPart)
    Dim Offsets(): Offsets = VBA.Array(0, 1, 2)
    Dim Contents():
    Contents = VBA.Array("Values", "Formulas", "A formula spilling")
    
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    
    Dim rg As Range, maxCell As Range, MaxValue, DateString As String

    Dim FindValues(), FindValue, i As Long, a As Long, o As Long, f As Long

    For o = 0 To UBound(Offsets)
        
        Set rg = ws.Range("L2:L10").Offset(, Offsets(o))
        MaxValue = Application.Max(rg)
        FindValues = VBA.Array( _
            CDate(MaxValue), _
            CLng(MaxValue), _
            Format(MaxValue, "mm\/dd\/yyyy") _
            )
        
        Debug.Print String(80, "-")
        Debug.Print Contents(o) & " in range """ & rg.Address(0, 0) & """"
        Debug.Print String(80, "-")
        Debug.Print "Value (TypeName, Vartype)", "Found ", _
            "Lookin", "LookAt", "Cell"
        
        For f = 0 To UBound(FindValues)
            
            FindValue = FindValues(f)
            DateString = FindValue & " (" _
                & TypeName(FindValue) & ", " & VarType(FindValue) & ")"
        
            For i = 0 To UBound(Ins)
                For a = 0 To UBound(Ats)
                    On Error Resume Next
                        Set maxCell = rg.Find(What:=FindValue, _
                            After:=rg.Cells(rg.Cells.Count), _
                            LookIn:=Ins(i), LookAt:=Ats(i))
                    On Error GoTo 0
                    
                    If maxCell Is Nothing Then
                        Debug.Print DateString, "No    ", _
                            Ins(i), Ats(a)
                    Else
                        Debug.Print DateString, "Yes   ", _
                            Ins(i), Ats(a), maxCell.Address(0, 0)
                        Set maxCell = Nothing
                    End If
                Next a
            Next i
            
        Next f
    
    Next o

End Sub 

测试结果

--------------------------------------------------------------------------------
Values in range "L2:L500"
--------------------------------------------------------------------------------
Value (TypeName, Vartype)   Found         Lookin        LookAt        Cell
6.8.2023. (Date, 7)         No            -4163          1 
6.8.2023. (Date, 7)         No            -4163          2 
6.8.2023. (Date, 7)         Yes           -4123          1            L6
6.8.2023. (Date, 7)         Yes           -4123          2            L6
6.8.2023. (Date, 7)         No            -4185          1 
6.8.2023. (Date, 7)         No            -4185          2 
45144 (Long, 3)             No            -4163          1 
45144 (Long, 3)             No            -4163          2 
45144 (Long, 3)             No            -4123          1 
45144 (Long, 3)             No            -4123          2 
45144 (Long, 3)             No            -4185          1 
45144 (Long, 3)             No            -4185          2 
08/06/2023 (String, 8)      Yes           -4163          1            L8
08/06/2023 (String, 8)      Yes           -4163          2            L8
08/06/2023 (String, 8)      No            -4123          1 
08/06/2023 (String, 8)      No            -4123          2 
08/06/2023 (String, 8)      No            -4185          1 
08/06/2023 (String, 8)      No            -4185          2 
--------------------------------------------------------------------------------
Formulas in range "M2:M500"
--------------------------------------------------------------------------------
Value (TypeName, Vartype)   Found         Lookin        LookAt        Cell
6.8.2023. (Date, 7)         No            -4163          1 
6.8.2023. (Date, 7)         No            -4163          2 
6.8.2023. (Date, 7)         No            -4123          1 
6.8.2023. (Date, 7)         No            -4123          2 
6.8.2023. (Date, 7)         No            -4185          1 
6.8.2023. (Date, 7)         No            -4185          2 
45144 (Long, 3)             No            -4163          1 
45144 (Long, 3)             No            -4163          2 
45144 (Long, 3)             No            -4123          1 
45144 (Long, 3)             No            -4123          2 
45144 (Long, 3)             No            -4185          1 
45144 (Long, 3)             No            -4185          2 
08/06/2023 (String, 8)      Yes           -4163          1            M8
08/06/2023 (String, 8)      Yes           -4163          2            M8
08/06/2023 (String, 8)      No            -4123          1 
08/06/2023 (String, 8)      No            -4123          2 
08/06/2023 (String, 8)      No            -4185          1 
08/06/2023 (String, 8)      No            -4185          2 
--------------------------------------------------------------------------------
A formula spilling in range "N2:N500"
--------------------------------------------------------------------------------
Value (TypeName, Vartype)   Found         Lookin        LookAt        Cell
6.8.2023. (Date, 7)         No            -4163          1 
6.8.2023. (Date, 7)         No            -4163          2 
6.8.2023. (Date, 7)         No            -4123          1 
6.8.2023. (Date, 7)         No            -4123          2 
6.8.2023. (Date, 7)         No            -4185          1 
6.8.2023. (Date, 7)         No            -4185          2 
45144 (Long, 3)             No            -4163          1 
45144 (Long, 3)             No            -4163          2 
45144 (Long, 3)             No            -4123          1 
45144 (Long, 3)             No            -4123          2 
45144 (Long, 3)             No            -4185          1 
45144 (Long, 3)             No            -4185          2 
08/06/2023 (String, 8)      Yes           -4163          1            N8
08/06/2023 (String, 8)      Yes           -4163          2            N8
08/06/2023 (String, 8)      No            -4123          1 
08/06/2023 (String, 8)      No            -4123          2 
08/06/2023 (String, 8)      No            -4185          1 
08/06/2023 (String, 8)      No            -4185          2 

0
投票

您知道您可以使用此公式获取该信息吗?

=ROW(INDEX(B$3:B$11,MATCH(MAX(B$3:B$11),B$3:B$11,0)))

让我解释一下它是如何工作的:

  • MAX(B$3:B$11)
    计算最大值。
  • MATCH(MAX(B$3:B$11),B$3:B$11,0)
    查找该列表中的最大值(使用“0”表示“完全匹配”)。
  • INDEX(...)
    查找同一数组中找到的最大值的索引。
  • ROW(...)
    。嗯,这很明显:-)

玩得开心

© www.soinside.com 2019 - 2024. All rights reserved.