Sortierung in MsgBox

[dertommy]

Super perfekt, danke sehr, so habe ich mir das vorgestellt

[dertommy]

Hallo!

Ich muss das Thema leider noch einmal aufgreifen, weil ich vor einem Problem stehe.
Euer Code hat bis jetzt super funktioniert. Nun habe ich den Code in eine andere Tabelle mit anderen Werten eingefügt und und ist es so, dass der 8. Rang nicht angezeigt wird und ich weiß nicht warum.
Vielleicht kann mich ja irgend jemand aufklären, warum nur 7 Ränge angezeigt werden und nicht 8. Es liegt sicher an den Daten (Zahlen), aber ich finde keine Prüfung im VBA Code, wo ich darauf schließen könnte, warum der 8. Rang in Höhe von € 5,49 nicht angezeigt wird.
Ich habe die Datei mit angehängt. Einfach auf "Ranking" klicken und man sieht nur 7 Ränge, obwohl ich eigentlich 8 Ränge erwartet hätte.
Ich danke euch jetzt schon.

LG
Thomas

[schauan]

Hallöchen,

kommentiere diese Zeile
'If i <= WorksheetFunction.Min(8, Cells(Zeile, Sp).Value) Then
aus und das zugehörige End If ...

[dertommy]

Hallo!

Danke, dass sich so schnell wer den Code angesehen hat.
Das kann ich aber leider nicht auskommentieren, da sonst Werte mit 0 angezeigt werden, was ich nicht will. Das ist schon bewusst so. In dieser Tabelle werden zwar keine 0 Werte angezeigt, aber ich habe eine andere, da werden 0 Werte angezeigt.

[schauan]

Hallöchen,

eine alternative Bedingung wäre dann If WWert > 0 Then

[dertommy]

Hallo!

Danke für den Code. Jetzt funktioniert es genau so, wie ich es mir vorstelle, auch in anderen Tabellen.

LG
Thomas

[dertommy]

Hallo!

Ich möchte dieses Thema nochmals aufgreifen, weil ich noch gerne eine Optimierung hätte.
Ich möchte, dass der Wert " aktuellesJahr" nur angezeigt werden, wenn beim aktuellen Jahr der Rang größer als 8 ist, sprich ab 9. Sonst soll "aktuellesJahr" gar nicht angezeigt werden.
Des weiteren möchte ich dann den Rang, das aktuelle Jahr, die Summe und die Anzahl wieder in der Msg stehen haben, wenn die oben genannten Kriterien erfüllt sind.
Das Jahr steht in der Spalte 1, der Rang in 8, die Summe in 12 und die Anzahl in 13.

Code:

Sub JahresstatistikRanking()

With ThisWorkbook.Worksheets("Jahresstatistik")
   
    Dim i, i1, WWert, WWert1 As Double, TText, TText1 As String, Zeile, Zeile1 As Integer, Sp, Sp1, Rang, Rang1 As Integer
    Dim Z1 As Integer, LR, LR1 As Integer, rng, rng1 As Range, Jahr, Jahr1 As Integer, TMP, TMP1 As String
       
    Z1 = 3 'Erste Datenzeile
    Sp = 12 'Werte in L
    Sp1 = 15 'Werte in O
       
    LR = Cells(Rows.Count, Sp).End(xlUp).Row 'letzte Zeile der Spalte
    LR1 = Cells(Rows.Count, Sp1).End(xlUp).Row 'letzte Zeile der Spalte

    Set rng = Cells(Z1, Sp).Resize(LR + Z1 + 1, 1)
    Set rng1 = Cells(Z1, Sp1).Resize(LR1 + Z1 + 1, 1)
    Anz = Application.WorksheetFunction.Min(8, Application.WorksheetFunction.CountIf(rng, ">0"))
    Anz1 = Application.WorksheetFunction.Min(8, Application.WorksheetFunction.CountIf(rng1, ">0"))
       
    For i = 1 To 8
        WWert = WorksheetFunction.Large(rng, i)
        Zeile = WorksheetFunction.Match(WWert, rng, 0) + Z1 - 1
        If WWert > 0 Then
            Jahr = Year(Cells(Zeile, 1))
            Rang = Cells(Zeile, 8)
            AnzahlAuszahlungen = Cells(Zeile, 13)
            TMP = IIf(Jahr = Year(Date), "  - aktuelles Jahr", "")
            aktuellesJahr = ". Rang:  " & Year(Date) & ":"
            TText = TText & Rang & ". Rang:  " & Jahr & ": " & " € " & Format(WWert, "#,##0.00") & "  (" & AnzahlAuszahlungen & " Auszahlungen)" & TMP & vbLf
        End If
    Next
       
    For i1 = 1 To 8
        WWert1 = WorksheetFunction.Large(rng1, i1)
        Zeile1 = WorksheetFunction.Match(WWert1, rng1, 0) + Z1 - 1
        If WWert1 > 0 Then
            Jahr1 = Year(Cells(Zeile1, 1))
            Rang1 = Cells(Zeile1, 16)
            AnzahlAuszahlungen1 = Cells(Zeile1, 17)
            TMP1 = IIf(Jahr1 = Year(Date), "  - aktuelles Jahr", "")
            TText1 = TText1 & Rang1 & ". Rang:  " & Jahr1 & ": " & " € " & Format(WWert1, "#,##0.00") & "  (" & AnzahlAuszahlungen1 & " Auszahlungen)" & TMP1 & vbLf
        End If
    Next
       
    MsgBox "Top " & Anz & " (berechnet bis Jahresende)" & vbLf & vbLf & TText & String(2, vbNewLine) & _
    aktuellesJahr & String(2, vbNewLine) & _
    "Top " & Anz1 & " (berechnet bis heute (" & Format(Date, "dd.mm") & ".XXXX" & "))" & vbLf & vbLf & TText1
     
End With

End Sub

Ich hoffe, dass mir wieder jemand helfen kann.

LG
Thomas

[RPP63]

Moin!
Ich bin dann mal #38:
Auswertungen per MsgBox machen ähnlichen Sinn wie Sattwerden mit einer Speisekarte!
Verrätst Du uns, was der tiefere Sinn dieses mittlerweile 9 Monate alten Threads ist?
Ich jedenfalls würde so etwas immer mit Formeln oder Pivot abbilden.
Damit kann man zumindest weiter arbeiten; eine MsgBox kann man nur lesen.

21 Variablen (die auch noch falsch deklariert sind)!
Sonst geht es Dir gut?

Gruß Ralf

[snb]

QEE: Quod erat expectandum

[schauan]

Hallöchen,

vielleicht was in der Art:

statt
If WWert > 0 Then

dann
If WWert > 0 And Cells(Zeile, 8) > 8 Then