Public Sub Main()
Dim lngTMP As Long
On Error GoTo Fin
Application.EnableEvents = False
lngTMP = Cells(Rows.Count, "J").End(xlUp).Row
Dim Vergleichsadresse As String
Vergleichsadresse = "F7"
Dim ergebnis As Range
Set ergebnis = Range(Application.Evaluate("=ADDRESS(MATCH(MAX(IF(YEAR(A23:A" & lngTMP & ")=" & Vergleichsadresse & ",J23:J" & lngTMP & ")),J23:J" & lngTMP & ",0)+22,10)"))
Application.Goto ergebnis, True
'ergebnis.Interior.ColorIndex = xlNone 'überflüssig
ergebnis.Interior.ColorIndex = 33
ActiveWindow.ScrollColumn = 1
MsgBox "Der höchste Stand aus " & Range(Vergleichsadresse) & " ist " & ergebnis.Value, vbInformation + vbOKOnly
Fin:
Application.EnableEvents = True
If Err.Number <> 0 Then MsgBox "Jahr nicht vorhanden!", vbCritical
End Sub
Function MaxWertJahr(rngAll As Range, Jahr As Long)
Dim f As String
f = "MAX(IF(YEAR(" & rngAll.Columns(1).Address & ")=" & Jahr & "," & rngAll.Columns(2).Address & "))"
MaxWertJahr = Evaluate(f)
End Function
=MaxWertJahr(A1:B323;F27)
Function MaxWertJahr(rngAll As Range, Jahr As Long)
MaxWertJahr = Evaluate("MAX(IF(YEAR(" & rngAll.Columns(1).Address & ")=" & Jahr & "," & rngAll.Columns(2).Address & "))")
End Function
Sub MaxMarkieren()
Dim rngAll As Range: Set rngAll = Tabelle1.Range("A1:B" & Tabelle1.Cells(Rows.Count, 1).End(xlUp).Row)
Dim Jahr&: Jahr = Tabelle1.Range("F27")
Dim iMax#: iMax = Evaluate("MAX(IF(YEAR(" & rngAll.Columns(1).Address & ")=" & Jahr & "," & rngAll.Columns(2).Address & "))")
Dim iRow: iRow = Evaluate("MATCH(1,(YEAR(" & rngAll.Columns(1).Address & ")=" & Jahr & ")*(" & rngAll.Columns(2).Address & "=" & iMax & "),0)")
rngAll.Columns(2).Interior.Color = xlNone
If Not IsError(iRow) Then
rngAll.Columns(2).Cells(iRow).Interior.Color = vbGreen
Else
MsgBox "kein Treffer", vbInformation
End If
End Sub
Sub WertJ() ' Aufruf für Spalte J
Call MaxMarkieren(Datum:=Tabelle2.Range("A23:A" & Tabelle2.Cells(Rows.Count, 1).End(xlUp).Row), Werte:=Tabelle2.Range("J23:J" & Tabelle2.Cells(Rows.Count, 1).End(xlUp).Row), Jahr:=Tabelle2.Range("F21"))
End Sub
Sub WertL() ' Aufruf für Spalte L
Call MaxMarkieren(Datum:=Tabelle2.Range("A23:A" & Tabelle2.Cells(Rows.Count, 1).End(xlUp).Row), Werte:=Tabelle2.Range("L23:L" & Tabelle2.Cells(Rows.Count, 1).End(xlUp).Row), Jahr:=Tabelle2.Range("F21"))
End Sub
Sub MaxMarkieren(Datum As Range, Werte As Range, Jahr As Long)
Dim iMax#: iMax = Evaluate("MAX(IF(YEAR(" & Datum.Address & ")=" & Jahr & "," & Werte.Address & "))")
Dim iRow: iRow = Evaluate("MATCH(1,(YEAR(" & Datum.Address & ")=" & Jahr & ")*(" & Werte.Address & "=MAX(IF(YEAR(" & Datum.Address & ")=" & Jahr & "," & Werte.Address & "))),0)")
Werte.Interior.Color = xlNone
If Not IsError(iRow) Then
Werte.Cells(iRow).Interior.Color = vbGreen
MsgBox "Jahr: " & Jahr & ": " & iMax
Else
MsgBox "kein Treffer", vbInformation
End If
End Sub
Sub MaxMarkieren(Datum As Range, Werte As Range, Jahr As Long)
Dim iMax#: iMax = Evaluate("MAX(IF(YEAR(" & Datum.Address & ")=" & Jahr & "," & Werte.Address & "))")
Dim iRow: iRow = Evaluate("MATCH(1,(YEAR(" & Datum.Address & ")=" & Jahr & ")*(" & Werte.Address & "=MAX(IF(YEAR(" & Datum.Address & ")=" & Jahr & "," & Werte.Address & "))),0)")
Werte.Interior.Color = xlNone
If Not IsError(iRow) Then
Werte.Cells(iRow).Interior.Color = vbGreen
Application.Goto Datum.Cells(iRow, 1), True
MsgBox "Der höchste Stand aus: " & Jahr & ": " & iMax & " in Zeile: " & iRow
Else
MsgBox "kein Treffer", vbInformation
End If
End Sub