15.11.2022, 08:29
16.03.2023, 08:06
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
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
16.03.2023, 08:33
Hallöchen,
kommentiere diese Zeile
'If i <= WorksheetFunction.Min(8, Cells(Zeile, Sp).Value) Then
aus und das zugehörige End If ...
kommentiere diese Zeile
'If i <= WorksheetFunction.Min(8, Cells(Zeile, Sp).Value) Then
aus und das zugehörige End If ...
16.03.2023, 08:38
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.
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.
16.03.2023, 08:45
Hallöchen,
eine alternative Bedingung wäre dann If WWert > 0 Then
eine alternative Bedingung wäre dann If WWert > 0 Then
16.03.2023, 08:53
Hallo!
Danke für den Code. Jetzt funktioniert es genau so, wie ich es mir vorstelle, auch in anderen Tabellen.
LG
Thomas
Danke für den Code. Jetzt funktioniert es genau so, wie ich es mir vorstelle, auch in anderen Tabellen.
LG
Thomas
11.07.2023, 10:03
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.
Ich hoffe, dass mir wieder jemand helfen kann.
LG
Thomas
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 SubIch hoffe, dass mir wieder jemand helfen kann.
LG
Thomas
11.07.2023, 16:39
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
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
11.07.2023, 16:49
QEE: Quod erat expectandum
12.07.2023, 10:33
Hallöchen,
vielleicht was in der Art:
statt
If WWert > 0 Then
dann
If WWert > 0 And Cells(Zeile, 8) > 8 Then
vielleicht was in der Art:
statt
If WWert > 0 Then
dann
If WWert > 0 And Cells(Zeile, 8) > 8 Then