09.10.2023, 12:25 (Dieser Beitrag wurde zuletzt bearbeitet: 09.10.2023, 12:54 von dertommy.)
Hallo!
Hier meine Datei, da passiert es schon, aber wahrscheinlich mache ich auch etwas falsch.
In deinem Screenshot sehe ich, dass das Jahr 2023 im unteren Block ganz unten nicht angezeigt wird. Das wäre nämlich genau das, was ich nämlich brauche. Wenn das Jahr 2023 nicht in den ersten 8 Rängen ist, soll es unter bei angezeigt werden.
es ist falsch, was du gemacht hast. Gehe den Weg, welchen ich dir beschrieben habe, um die Stelle zu finden wo der Codeschnipsel (welcher auch nur erst mal für das obere Array ist) rein muss.
Für das untere Array nimmst du diesen Codeschnipsel und passt die Variablen, Array ... entsprechend an.
Es hilft dir nicht den Code von hier aus weiter fertig vorzusetzten --> du übernimmst dann Diesen --> um dann leider nichts gelernt zu haben.
Es ist nicht böse gemeint von mir. Gehe in den VBA Editor, öffne und nehme das Direktfenster zu Hilfe und gehe mit F8 Step by Step den Code durch.
Da siehst und lernst du, was passiert.
Ich habe, da ich dies nur als Hobby betreibe und kein Informatiker bin, auch nur genau über diesem Weg mir diesen Wissenstand erübt/erlernt.
Glaube mir, es macht riesig Spaß, wenn man feststellt: Ich habe es selbst hinbekommen.
Kleiner Hinweis der Codeschnipsel muss dahin, wo die Stringvariable Text1 gefüllt wird.
Dieser Codeschnipsel prüft, wenn i=8, ob das aktuelle Jahr im Text1 enthalten ist.
Wenn ja wird der nächste Rang noch mit übernommen und wenn nein dann wird im Array das aktuelle Jahr gesucht und im Rang 8 im Text1 ausgegeben.
Moin!
Hab ich eigentlich irgendwann in diesem Endlosthread gefragt, welchen Vorteil man mit einer MsgBox hat?
Nö, habe ich nicht!
Dann aber jetzt:
Wer liest sich eine Box durch?
Und falls doch: Was macht man damit?
Man kann ja noch nicht einmal markieren & C&P
Ich bin aber schon wieder weg!
Gruß Ralf
Gib einem Mann einen Fisch und du ernährst ihn für einen Tag.
Lehre einen Mann zu fischen und du ernährst ihn für sein Leben. (Konfuzius)
ja, man kann diese MsgBox nur angucken und wegklicken. Mehr eben nicht.
Was mich dran interessierte war die Möglichkeit in Arrays zu bauen.
Den alten Thread hatte ich mal am Wochenende gelesen und gesehen, dass es auch alles so tröpfchenweise ablief.
10.10.2023, 08:52 (Dieser Beitrag wurde zuletzt bearbeitet: 10.10.2023, 09:51 von dertommy.)
Hallo Egon12!
Danke dir nochmals für deine Ausführungen. Ich werde mir das in Ruhe durchschauen, was du mir für Tipps gegeben hast.
Nachdem ich deinen Code auch in einer anderen Tabelle mit gleichen Werte verwenden kann, aber wo das Ranking auch doppelte Werte anzeigen kann, würde ich gerne wissen, ob dein Code abgeändert werden muss? Ich habe meine Formeln zur Berechnung der Ränge geändert, dadurch kommen jetzt auch doppelte Ränge vor, was in meiner anderen Tabelle auch OK ist.
Ich habe nun einen älteren Code von dir genommen, bevor du eingebaut hast, dass bei beiden Teilen in der MsgBox KEINE doppelte Ränge angezeigt werden.
Ich habe den Code von dir genommen und er zeigt mir auch in beiden Teilen doppelte Ränge mit unterschiedlichen Jahreszahlen, Werten und diesbezüglichen Auszahlungen an, was auch am ersten Blick korrekt ist.
Ich würde dich aber nochmals darum bitten, kurz über den Code drüber zusehen und mir eventuell zu sagen, ob nicht doch etwas an dem Code verändert muss, dass doppelte Ränge angezeigt werden, auch, wenn es derzeit mit meinen Daten offensichtlich funktioniert.
Anbei nun dein Code:
Code:
Option Explicit
Sub JahresstatistikRanking()
Dim arrList(), arrList1(), arrList2(), arrTmp1(), arrTmp2(), iTemp, i&, j&, k&, Anz1&, Anz2&, Text2$, Text1$
arrList = Tabelle10.Range("A3:Q" & Tabelle10.Cells(Rows.Count, 1).End(xlUp).Row) ' Array laden Spalte A bis Q
arrList1 = Application.Index(arrList, Evaluate("row(1:" & UBound(arrList, 1) & ")"), Array(1, 8, 12, 13)) ' Übergabe der Spalte 1(A), 8(H),12(L),13(M)
arrList2 = Application.Index(arrList, Evaluate("row(1:" & UBound(arrList, 1) & ")"), Array(1, 16, 15, 17)) ' Übergabe der Spalte 1(A), 16(P),15(O),17(Q)
For i = 1 To UBound(arrList1)
If arrList1(i, 3) > 0 Then
k = k + 1
ReDim Preserve arrTmp1(1 To 4, 1 To k) ' Filtern des Array auf vorhandenen Betrag
arrTmp1(1, k) = Year(arrList1(i, 1))
arrTmp1(2, k) = arrList1(i, 2)
arrTmp1(3, k) = arrList1(i, 3)
arrTmp1(4, k) = arrList1(i, 4)
End If
If arrList2(i, 3) > 0 Then ' Filtern des Array auf vorhandenen Betrag
j = j + 1
ReDim Preserve arrTmp2(1 To 4, 1 To j)
arrTmp2(1, j) = Year(arrList2(i, 1))
arrTmp2(2, j) = arrList2(i, 2)
arrTmp2(3, j) = arrList2(i, 3)
arrTmp2(4, j) = arrList2(i, 4)
End If
Next i
ReDim Preserve arrTmp1(1 To 4, 1 To k)
ReDim Preserve arrTmp2(1 To 4, 1 To j)
arrList1 = Application.Transpose(arrTmp1)
For k = 1 To UBound(arrList1)
For i = 1 To UBound(arrList1) - 1 ' Sortieren der Rangnummern aufsteigend
If arrList1(i, 2) > arrList1(i + 1, 2) Then
For j = 1 To UBound(arrList1, 2)
iTemp = arrList1(i, j)
arrList1(i, j) = arrList1(i + 1, j)
arrList1(i + 1, j) = iTemp
Next j
End If
Next i
Next k
k = 0
For i = 1 To UBound(arrList1) ' Aufbereiten des Textblockes mit Zeilenumbruch
If Year(DateSerial(arrList1(i, 1), 1, 1)) = CDbl(Year(Date)) Then
Text1 = Text1 & arrList1(i, 2) & ". Rang: Jahr: " & arrList1(i, 1) & ": € " & Format(arrList1(i, 3), "#,##0.00") & " (" & arrList1(i, 4) & " Auszahlungen)" & " - aktuelles Jahr" & vbLf
Anz1 = Anz1 + 1
If i = 8 Then Exit For
Else
Text1 = Text1 & arrList1(i, 2) & ". Rang: Jahr: " & arrList1(i, 1) & ": € " & Format(arrList1(i, 3), "#,##0.00") & " (" & arrList1(i, 4) & " Auszahlungen)" & vbLf
Anz1 = Anz1 + 1
If i = 8 Then Exit For
End If
Next i
Text1 = Left(Text1, Len(Text1) - 1)
arrList2 = Application.Transpose(arrTmp2)
For k = 1 To UBound(arrList2)
For i = 1 To UBound(arrList2) - 1 ' Sortieren der Rangnummern aufsteigend
If arrList2(i, 2) > arrList2(i + 1, 2) Then
For j = 1 To UBound(arrList2, 2)
iTemp = arrList2(i, j)
arrList2(i, j) = arrList2(i + 1, j)
arrList2(i + 1, j) = iTemp
Next j
End If
Next i
Next k
For i = 1 To UBound(arrList2) ' Aufbereiten des Textblockes mit Zeilenumbruch
If Year(DateSerial(arrList2(i, 1), 1, 1)) = CDbl(Year(Date)) Then
Text2 = Text2 & arrList2(i, 2) & ". Rang: Jahr: " & arrList2(i, 1) & ": € " & Format(arrList2(i, 3), "#,##0.00") & " (" & arrList2(i, 4) & " Auszahlungen)" & " - aktuelles Jahr" & vbLf
Anz2 = Anz2 + 1
If i = 8 Then Exit For
Else
Text2 = Text2 & arrList2(i, 2) & ". Rang: Jahr: " & arrList2(i, 1) & ": € " & Format(arrList2(i, 3), "#,##0.00") & " (" & arrList2(i, 4) & " Auszahlungen)" & vbLf
Anz2 = Anz2 + 1
If i = 8 Then Exit For
End If
Next i
Text2 = Left(Text2, Len(Text2) - 1)
' Ausgabe in Textbox
MsgBox "Top " & Anz1 & " (berechnet bis Jahresende)" & vbLf & vbLf & Text1 & vbLf & vbLf & _
"Top " & Anz2 & " (berechnet bis heute (" & Format(Date, "dd.mm") & ".XXXX" & "))" & _
vbLf & vbLf & Text2, , "Ranking der Auszahlungen"
End Sub
Option Explicit
Sub JahresstatistikRanking()
Dim arrList(), arrList1(), arrList2(), arrTmp1(), arrTmp2(), iTemp, i&, j&, k&, Anz1&, Anz2&, Text2$, Text1$
arrList = Tabelle10.Range("A3:Q" & Tabelle10.Cells(Rows.Count, 1).End(xlUp).Row) ' Array laden Spalte A bis Q
arrList1 = Application.Index(arrList, Evaluate("row(1:" & UBound(arrList, 1) & ")"), Array(1, 8, 12, 13)) ' Übergabe der Spalte 1(A), 8(H),12(L),13(M)
arrList2 = Application.Index(arrList, Evaluate("row(1:" & UBound(arrList, 1) & ")"), Array(1, 16, 15, 17)) ' Übergabe der Spalte 1(A), 16(P),15(O),17(Q)
For i = 1 To UBound(arrList1)
If arrList1(i, 3) > 0 Then
k = k + 1
ReDim Preserve arrTmp1(1 To 4, 1 To k) ' Filtern des Array auf vorhandenen Betrag
arrTmp1(1, k) = Year(arrList1(i, 1))
arrTmp1(2, k) = arrList1(i, 2)
arrTmp1(3, k) = arrList1(i, 3)
arrTmp1(4, k) = arrList1(i, 4)
End If
If arrList2(i, 3) > 0 Then ' Filtern des Array auf vorhandenen Betrag
j = j + 1
ReDim Preserve arrTmp2(1 To 4, 1 To j)
arrTmp2(1, j) = Year(arrList2(i, 1))
arrTmp2(2, j) = arrList2(i, 2)
arrTmp2(3, j) = arrList2(i, 3)
arrTmp2(4, j) = arrList2(i, 4)
End If
Next i
ReDim Preserve arrTmp1(1 To 4, 1 To k)
ReDim Preserve arrTmp2(1 To 4, 1 To j)
arrList1 = Application.Transpose(arrTmp1)
For k = 1 To UBound(arrList1)
For i = 1 To UBound(arrList1) - 1 ' Sortieren der Rangnummern aufsteigend
If arrList1(i, 2) > arrList1(i + 1, 2) Then
For j = 1 To UBound(arrList1, 2)
iTemp = arrList1(i, j)
arrList1(i, j) = arrList1(i + 1, j)
arrList1(i + 1, j) = iTemp
Next j
End If
Next i
Next k
k = 0
For i = 1 To UBound(arrList1) ' Aufbereiten des Textblockes mit Zeilenumbruch
If Year(DateSerial(arrList1(i, 1), 1, 1)) = CDbl(Year(Date)) Then
Text1 = Text1 & arrList1(i, 2) & ". Rang: Jahr: " & arrList1(i, 1) & ": € " & Format(arrList1(i, 3), "#,##0.00") & " (" & arrList1(i, 4) & " Auszahlungen)" & " - aktuelles Jahr" & vbLf
Anz1 = Anz1 + 1
If i = 8 Then Exit For
Else
Text1 = Text1 & arrList1(i, 2) & ". Rang: Jahr: " & arrList1(i, 1) & ": € " & Format(arrList1(i, 3), "#,##0.00") & " (" & arrList1(i, 4) & " Auszahlungen)" & vbLf
Anz1 = Anz1 + 1
If i = 8 Then Exit For
End If
Next i
Text1 = Left(Text1, Len(Text1) - 1)
arrList2 = Application.Transpose(arrTmp2)
For k = 1 To UBound(arrList2)
For i = 1 To UBound(arrList2) - 1 ' Sortieren der Rangnummern aufsteigend
If arrList2(i, 2) > arrList2(i + 1, 2) Then
For j = 1 To UBound(arrList2, 2)
iTemp = arrList2(i, j)
arrList2(i, j) = arrList2(i + 1, j)
arrList2(i + 1, j) = iTemp
Next j
End If
Next i
Next k
For i = 1 To UBound(arrList2) ' Aufbereiten des Textblockes mit Zeilenumbruch
If Year(DateSerial(arrList2(i, 1), 1, 1)) = CDbl(Year(Date)) Then
Text2 = Text2 & arrList2(i, 2) & ". Rang: Jahr: " & arrList2(i, 1) & ": € " & Format(arrList2(i, 3), "#,##0.00") & " (" & arrList2(i, 4) & " Auszahlungen)" & " - aktuelles Jahr" & vbLf
Anz2 = Anz2 + 1
If i = 8 Then Exit For
Else
Text2 = Text2 & arrList2(i, 2) & ". Rang: Jahr: " & arrList2(i, 1) & ": € " & Format(arrList2(i, 3), "#,##0.00") & " (" & arrList2(i, 4) & " Auszahlungen)" & vbLf
Anz2 = Anz2 + 1
If i = 8 Then Exit For
End If
Next i
Text2 = Left(Text2, Len(Text2) - 1)
' Ausgabe in Textbox
MsgBox "Top " & Anz1 & " (berechnet bis Jahresende)" & vbLf & vbLf & Text1 & vbLf & vbLf & _
"Top " & Anz2 & " (berechnet bis heute (" & Format(Date, "dd.mm") & ".XXXX" & "))" & _
vbLf & vbLf & Text2, , "Ranking der Auszahlungen"
End Sub
Mir ist bewusst, dass es jetzt genau das Gegenteil von der ursprünglichen Anforderung ist, aber vielleicht kannst du mir ja trotzdem nochmals helfen, wäre echt super nett von dir.
Dem anderen Feature mit der Anzeige vom aktuellen Jahr werde ich mich dann widmen.
Update: In deinem Screenshot sehe ich, dass das Jahr 2023 im unteren Block ganz unten nicht angezeigt wird. Das wäre nämlich genau das, was ich nämlich brauche. Wenn das Jahr 2023 nicht in den ersten 8 Rängen ist, soll es unterbei angezeigt werden.
10.10.2023, 10:02 (Dieser Beitrag wurde zuletzt bearbeitet: 10.10.2023, 10:12 von dertommy.)
Hallo!
Ich habe nun mit deinem Code bezüglich dem aktuellen Jahr nun das gleiche Ergebnis wie in deinem Screenshot zusammen gebracht.
Nur ist es nicht das, was ich wollte. Vielleicht habe ich mich auch nicht klar ausgedrückt. Ich will, dass die Ränge ganz normal angezeigt werden, sprich in diesem Beispiel von 1 - 8 und dann soll eine Leerzeile kommen und dann soll als 10. Rang das aktuelle Jahr angezeigt werden aber nur, wenn das aktuelle Jahr nicht in den ersten 8 Rängen vorkommt.
11.10.2023, 09:30 (Dieser Beitrag wurde zuletzt bearbeitet: 11.10.2023, 09:32 von dertommy.)
Hallo Egon12!
Ich habe mir jetzt deinen Code bezüglich dem Jahr 2023 genauer angesehen und da ist mir aufgefallen, dass du den 8. Rang fix hinschreibst, was falsch ist. Es könnte ja auch z.B. der 10 oder 11. sein. Ich will den Rang bei 2023 stehen haben, welcher in der Formel errechnet wird.
Wie schon im vorigen Post geschrieben will ich, dass die Ränge ganz normal angezeigt werden, sprich in diesem Beispiel von 1 - 8 und dann soll eine Leerzeile kommen und dann soll als 10. Rang das aktuelle Jahr angezeigt werden aber nur, wenn das aktuelle Jahr nicht in den ersten 8 Rängen vorkommt.
na, das wundert doch nicht so sehr; die wirklich sinnvollen Beiträge wurden ja schon vor einem Jahr ignoriert.
Gewünscht ist eine Lösung X für ein Problem Y, bei dem der TE nicht selbst in der Lage ist, sich zu helfen. Beiträge außerhalb vom Codelieferdienst (die würden Umdenken erfordern) werden geflissentlich ignoriert.
Im Zuge einer Anforderung kann es natürlich vorkommen, dass sich etwas ändert, das ist normal würde ich sagen.
Ich habe nun versucht, den Code bezüglich dem aktuellen Jahr einzubinden und bin einen Schritt weiter, aber es nicht perfekt. (Der Tipp mit F8 funktioniert bei mir nicht richtig, er springt immer bei den gleichen Stellen herum und mir bringt das leider nichts).
1. Problem:
Momentan ist es so, dass das aktuelle Jahr 2023 außerhalb der Top 8 angezeigt wird, aber leider mit dem falschen Rang. Es wird nämlich der 9. Rang angezeigt, was falsch ist. Es sollte nämlich der 10. Rang angezeigt werden. Da kommen wir zu meinem vorigen Problem, was ich angesprochen habe, ob der Code bezüglich des Rankings richtig ist. Denn bei meiner jetzigen Version will ich nämlich ganz die Ränge angezeigt bekommen, die die Formeln berechnen.
2. Problem:
Wenn das aktuelle Jahr in den Rängen 1 - 8 ist, werden 9 Ränge angezeigt, was ich nicht will. Ich will weiterhin nur max. 8 Ränge angezeigt bekommen. Am besten kann man es testen, wenn man in der Tabelle Auszahlungen beim Datum 25.01.2023 den Betrag von 4 auf 16 und umgekehrt ändert. Das wirkt sich dann sofort in der MsgBox aus.
F8 zwecks Analyse wie was abläuft ist normal und funktioniert auch bei dir. Was dir offensichtlich fehlt ist Ausdauer.
Was da "hin und her springt" ist ein Schleifendurchlauf.
Mittels des gleichzeitigen beobachten des Direktfensters erkennst du, wie die in den Arrays enthaltenen Werte verarbeitet bzw. übergeben werden.
Setzte dich damit auseinander.
Dann findest du auch heraus wie eine Abfrageschleife funktioniert, wie der gesuchte Wert (aktuelles Jahr) als Sprungpunkt gefunden und wie zum Schluss mit den Zeilenumbruch in die Variable übergeben werden kann.
Ich habe die Geduld dir den Weg aufzuzeigen.
Jetzt bist du dran die Geduld aufzubringen um den Lösungsweg zu finden.
Ich hoffe auf eine positive Nachricht nebst Lösung mittels deiner Leistung.
