Excel- Makro führt Rangordnung in falsche Richtung aus

Hallo Zusammen,

ich habe folgendes Makro, was die Aufgabe hat Blätter durchzugehen, eine Liste zu vervollständigen und diese im Anschluss nach Jahren zu ranken.

Ich habe zwei Probleme mit derm Makro:
1) Es stoppt nach dem ersten Blatt.
2) Das Ranking geht in die falsche Richtung. Aktuell vergibt es den Rang 1. für das aktuellste Jahr. Ältere Jahre erhalten die nachfolgenden Ränge. Es sollte allerdings Rang 1. für das älteste Jahr vergeben.
z.B. 1980 -Rang 1
1985 Rang 2

Kann mir jemand weiterhelfen??

Tausend Dank!

Sub hallo()
For Each sht In ActiveWorkbook.Worksheets
sht.Activate
If Not Left(sht.Name, 1) = "C" Then
a = Range("A3").Value
b = Range("C5").Value
Cells.Find(What:="Other Funds Managed by Firm", After:=ActiveCell, LookIn _
:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
c = ActiveCell.Row + 2
Selection.End(xlDown).Select
Selection.Offset(1, 0).Select
Selection.Value = a
Selection.Offset(0, 3).Value = b
Selection.Offset(0, 4).Formula = "=RANK.EQ(" & Replace(Selection.Offset(0, 3).Address, "$", "") & "," & Range(Selection.Offset(0, 3).Address, Cells(c, Selection.Offset(0, 3).Column)).Address & ")"
Selection.Offset(0, 4).Copy
Range(Selection.Offset(-1, 4), Cells(c, Selection.Offset(0, 4).Column)).Select
ActiveSheet.Paste
End
End If
Next

End Sub

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 208460

Url: https://administrator.de/forum/excel-makro-fuehrt-rangordnung-in-falsche-richtung-aus-208460.html

Ausgedruckt am: 23.04.2025 um 09:04 Uhr

11 Kommentare

Neuester Kommentar

Hallo CheersToExcel!

Wundert mich nicht, dass der Code schon beim 1.Sheet aussteigt...

Allerdings hast Du den Code nicht in Codetags gesetzt, insofern spare ich mir die Mühe näher darauf einzugehen

Gruß Dieter

Hallo CheersToExcel,
ich gehe mal nur auf die Funktion RANK.EQ oder RANG-GLEICH ein:

RANG.GLEICH(Zahl;Bezug;[Reihenfolge])

Die Syntax der Funktion RANG.GLEICH weist die folgenden Argumente auf:
Zahl Erforderlich. Die Zahl, deren Rangzahl Sie bestimmen möchten
Bezug Erforderlich. Ein Array von oder ein Bezug auf eine Liste mit Zahlen. Nicht numerische Werte im Bezug werden ignoriert.
Reihenfolge Optional. Eine Zahl, die angibt, wie der Rang von Zahl bestimmt werden soll

Ist Reihenfolge mit 0 (Null) belegt oder nicht angegeben, bestimmt Microsoft Excel den Rang von Zahl so, als wäre Bezug eine in absteigender Reihenfolge sortierte Liste.

Ist Reihenfolge mit einem Wert ungleich 0 belegt, bestimmt Microsoft Excel den Rang von Zahl so, als wäre Bezug eine in aufsteigender Reihenfolge sortierte Liste.

Grüße Uwe

Hallo Dieter,
vielen Dank für den Hinweis!

Sub hallo()
For Each sht In ActiveWorkbook.Worksheets
sht.Activate
If Not Left(sht.Name, 1) = "C" Then  
a = Range("A3").Value  
b = Range("C5").Value  
Cells.Find(What:="Other Funds Managed by Firm", After:=ActiveCell, LookIn _  
:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
c = ActiveCell.Row + 2
Selection.End(xlDown).Select
Selection.Offset(1, 0).Select
Selection.Value = a
Selection.Offset(0, 3).Value = b
Selection.Offset(0, 4).Formula = "=RANK.EQ(" & Replace(Selection.Offset(0, 3).Address, "$", "") & "," & Range(Selection.Offset(0, 3).Address, Cells(c, Selection.Offset(0, 3).Column)).Address & ")"  
Selection.Offset(0, 4).Copy
Range(Selection.Offset(-1, 4), Cells(c, Selection.Offset(0, 4).Column)).Select
ActiveSheet.Paste
End
End If
Next

End Sub

Hallo Uwe,

danke für die Korrektur! Das werde ich gleich sofort ausprobieren!

Hallo Uwe,
kannst Du mir vielleicht sagen, welchen Wert ich genau austauschen muss?! Vielen Dank!
VG

Am Ende der RANK.EQ Formel muss noch ein ;1 eingefügt werden

Vielen Dank!

Jetzt muss es nur noch alle Blätter durchgehen. Ideen?

Zeile 19 das End löschen.
ansonsten setz mal Breakpoints ...

Hallo,

ansonsten setz mal Breakpoints ...

Oder du tickerst dein VBA per Einzelschritt durch. F8 Taste im VBA Editor. Dann siehst du selbst an welcher Stelle sich dein Programm beendet und du kannst selbst entscheiden ob es das dort tun soll

Und bitte noch ein Wie kann ich einen Beitrag als gelöst markieren? dran gepappt.

Gruß,
Peter

Hallo CheersToExcel!

Und wenn ich das Ganze richtig verstanden habe, dann etwas vereinfacht so:

Sub hallo()
    For Each sh In ActiveWorkbook.Worksheets
        With sh
            If Left(.Name, 1) <> "C" Then  
                Set Fund = .Cells.Find("Other Funds Managed by Firm", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)  
                
                If Not Fund Is Nothing Then
                    Set r1 = Fund.Offset(2, 0)
                    Set r2 = r1.End(xlDown).Offset(1, 0)
                    
                    r2.Offset(0, 0).Value = .Range("A3").Value  
                    r2.Offset(0, 3).Value = .Range("C5").Value  
                    r1.Offset(0, 4).Formula = "=RANK.EQ(" & Replace(r1.Offset(0, 3).Address, "$", "") & "," & Range(r1.Offset(0, 3), r2.Offset(0, 3)).Address & ",1)"  
                    r1.Offset(0, 4).Copy .Range(r1.Offset(1, 4), r2.Offset(0, 4))
                End If
            End If
        End With
    Next
End Sub