Makro Einbau Abfrage Jahr aus F21

24.04.2026 10:12:29

chris58

Hallo !
Bitte kann mir ein Experte in den u.a. Code das Jahr der Abfrage, das in F21 steht, einbauen um den Höchsten Stand in diesem Jahr zu ermitteln ?
Danke für Eure Hilfe
chris58

Public Sub Main()
Dim lngTMP As Long
On Error GoTo Fin
Application.EnableEvents = False
lngTMP = Cells(Rows.Count, "J").End(xlUp).Row
Application.Goto Range(Application.Evaluate("=ADDRESS(MATCH(MAX(IF(YEAR(A23:A" & lngTMP & ")=F7,J23:J" & lngTMP & ")),J23:J" & lngTMP & ",0)+22,10)")), True
With Selection
.Interior.ColorIndex = xlNone
.Interior.ColorIndex = 33
End With
ActiveWindow.ScrollColumn = 1
Fin:
Application.EnableEvents = True
If Err.Number > 0 Then MsgBox "Jahr nicht vorhanden!", vbCritical
End Sub

AW: Makro Einbau Abfrage Jahr aus F21

24.04.2026 11:27:18

MCO

Moin!

Ich hoffe, ich hab es richtig verstanden: Vorgabejahr steht statt in F7 jetzt in F21, Ausgabe zusätzlich zur selection in Msgbox?

Ändere im folgenden Code die variable "Vergleichsadresse" in F21

Probier es mal aus:

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

Gruß, MCO

AW: Makro Einbau Abfrage Jahr aus F21

24.04.2026 11:53:03

Alwin Weisangler

Hallo Chris,

ich würde dies als UDF anlegen.
in ein allgemeines Modul:



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

Aufruf der UDF in Zelle deiner Wahl (beispielhaft):

=MaxWertJahr(A1:B323;F27)

https://www.herber.de/bbs/user/180612.xlsm

Gruß Uwe

AW: Makro Einbau Abfrage Jahr aus F21

24.04.2026 15:29:26

chris58

Hallo !
Ich möchte mich vorerst mal bedanken, das Ihr Eure Zeit geopfert habt um mir zu helfen.
Nun, ich habe den Code in meine Datei eingebaut, nur es hakt irgendwie. Darum habe ich die Datei mit Eurem Code hochgeladen um es anschaulich zu machen.
Also wenn ich in der Spalte J die höchste Zahl für ein bestimmtes Jahr aufrufe, dann geht das. Wenn ich allerdings das mit de Spalte L mache, dann geht das einfahch nicht.
Sehr Ihr den Fehler ? Könnt Ihr mir das korregieren - Danke vielmals.
Danke chris58

https://www.herber.de/bbs/user/180613.xls

AW: Makro Einbau Abfrage Jahr aus F21

24.04.2026 17:06:29

Alwin Weisangler

Hallo Chris,

teste mal:



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

AW: Makro Einbau Abfrage Jahr aus F21

24.04.2026 17:21:17

Alwin Weisangler

da hatte ich das Anspringen der passenden Zeile vergessen.

Tausche diese Prozedur aus:



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

Gruß Uwe

AW: Makro Einbau Abfrage Jahr aus F21

25.04.2026 10:04:33

chris58

Hallo Uwe !
Herzlichen Dank für dieses Makro. Es funktioniert einwandfrei.
Danke
chris58

AW: Makro Einbau Abfrage Jahr aus F21

25.04.2026 11:02:10

Alwin Weisangler

gerne.

Gruß Uwe

AW: Makro Einbau Abfrage Jahr aus F21

24.04.2026 12:25:11

Alwin Weisangler

falls es jemanden interessiert hier noch die UDF ohne Variable f:



Function MaxWertJahr(rngAll As Range, Jahr As Long)

    MaxWertJahr = Evaluate("MAX(IF(YEAR(" & rngAll.Columns(1).Address & ")=" & Jahr & "," & rngAll.Columns(2).Address & "))")

End Function

AW: Makro Einbau Abfrage Jahr aus F21

24.04.2026 15:02:02

Alwin Weisangler

Zelle färben für Höchstwert des Kalenderjahres:



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

Gruß Uwe

Makro Einbau Abfrage Jahr aus F21

Forumthread: Makro Einbau Abfrage Jahr aus F21

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Makro Einbau Abfrage Jahr aus F21

Forumthread: Makro Einbau Abfrage Jahr aus F21

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread