Zwei Arrays miteinander vergleichen und Berechnung durchführen

  • Excel

Es gibt 8 Antworten in diesem Thema. Der letzte Beitrag () ist von joerg_W.

    Zwei Arrays miteinander vergleichen und Berechnung durchführen

    Hallo Zusammen,

    ich bin mir sicher, einer von Euch kann mir weiterhelfen.

    Es geht darum: Ich habe eine Excel-Datei in der in den Spalten die Monate 1-12 dargestellt sind. In den Reihen sind bestimmte KPIs ausgewiesen. Nun bräuchte ich einen VBA Code, der mir für jede Zeile, sprich KPI, das aktuelle Monat mit dem Vormat vergleicht und mir anschließend in ein neues Tabellenblatt den Wert, sowie den dazugehörigen KPI- der immer in Spalte A steht herausschreibt, sobald sich der Wert des aktuellen Monats im Vergleich zum Vormonat um 10% geändert hat.

    Ich sitze schon tagelang an diesem Problem. Auch bin ich auf der Suche mit Google zwar auf Einträge gestossen, die ich jedoch mit meiner mangelnden VBA Erfahrung nicht für mich umsetzen kann.

    Hier als Beispiel mein Versuch um zu prüfen, ob die beiden Arrays die ich angelegt habe gleich sind. Hier kommt schon eine Fehlermeldung :)

    Sub test_3()

    Dim Vormonat, Vormonat_Index As Variant
    Dim Akt_Monat, Akt_Monat_Index As Variant
    Dim LetzteZeile As Variant

    LetzteZeile = Workbooks("XXX.xlsx").Worksheets("YYY...").Range("E1048576").End(xlUp).Row
    Vormonat = Workbooks("XXX.xlsx").Worksheets("YYY...").Range("E5:E" & LetzteZeile)
    Akt_Monat = Workbooks("Projekt Löwe.xlsx").Worksheets("Projekt Löwe...").Range("F5:F" & LetzteZeile)

    For Akt_Monat_Index = LBound(Akt_Monat) To UBound(Akt_Monat)
    For Vormonat_Index = LBound(Vormonat) To UBound(Vormonat)
    If Akt_Monat = Vormonat Then
    MsgBox "sind identisch"
    End If
    Next Vormonat_Index
    Next Akt_Monat_Index
    End Sub

    Ich wäre über jede, zeitnahe, Hilfe sehr dankbar. Ich verzweifle nämlich gerade.

    1000 Dank

    Jörg

    Hi,

    wenn ich dich halbwegs richtig verstanden habe sollte das dir weiter helfen:

    Visual Basic-Quellcode

    1. ​
    2. Sub FindKPI()
    3. Dim lastrow As Long
    4. Dim a As Long, b As Long, c As Long
    5. lastrow = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
    6. 'c ist die zeile für sheet 2
    7. c = 1
    8. 'zeilen (erste Zeile sind die Header, daher von 2 los)
    9. For a = 2 To lastrow
    10. 'spalten (erste Spalte stehen die KPI, daher von 2 los)
    11. For b = 2 To 12 'spalte 13 is letze, da kommt danach keine mehr zum vergleichen
    12. 'check ob der kpi 0 ist, da man mit 0 Probleme beim dividieren bekommt ;)
    13. If Sheets("Sheet1").Cells(a, b + 1) = 0 Then
    14. Sheets("Sheet2").Cells(c, 1) = Cells(a, 1) 'kpi
    15. Sheets("Sheet2").Cells(c, 2) = Cells(a, b + 1) 'wert
    16. Sheets("Sheet2").Cells(c, 3) = b 'monat
    17. c = c + 1
    18. ElseIf Abs(Sheets("Sheet1").Cells(a, b) / Sheets("Sheet1").Cells(a, b + 1) - 1) > 0.1 Then
    19. Sheets("Sheet2").Cells(c, 1) = Cells(a, 1)
    20. Sheets("Sheet2").Cells(c, 2) = Cells(a, b + 1)
    21. Sheets("Sheet2").Cells(c, 3) = b
    22. c = c + 1
    23. End If
    24. Next
    25. Next
    26. End Sub
    Das ist meine Signatur und sie wird wunderbar sein!

    Hallo Mono,

    mein Held! Danke erstmal das du mir so schnell geholfen hast, und vielen Dank für deine Mühen.

    Es klappt nahezu zu 100%. Das Programm schreibt mir in "Sheet1" für jedes KPI die Anzahl der Monate in die Zeilen. Z.B. Der KPI "Direct Project Cost" steht dann in der Zeile 1 bis 12. Der KPI "Internal Service" in der Zeile 13 bis 24, usw. Mir hätte schon ausgereicht, wenn für jeden KPI einzeln die Differenz zum Vormonat dargestellt wird.
    Hast du hierzu noch eine Idee, bzw. ich versuche auch mal parallel deine Vorgabe dementsprechend anzupassen.

    Auf alle Fälle nochmals 1000 Dank

    Jörg

    Ich verstehe es nicht so ganz. Gibt es also keine Spalten mit den Monaten?
    Sondern jeder Monat steht in Spalte 2 und dann die Zeilen runter von 1 bis 12?
    Das ist meine Signatur und sie wird wunderbar sein!

    Hallo,

    ich habe einmal ein Screenshot mit beigefügt. Das Makro soll den aktuellen Monat mit dem Vormonat vergleichen und dann die KPIs herausschreiben, die für diesen Vergleich eine Abweichung von >= 10% haben. In dem Beispiel soll also der KPI Labour Charged by Hourly Rate mit dem Februarwert verglichen werden. Und erst bei der Bedingung >=10% gegenüber den Vormonat soll der KPI, inkl. dem aktuellen Monatswert in Sheet2 übertragen werden.

    Schöne Grüße

    Jörg

    Sorry, hab gerade erfahren, dass ich keine Bilder hochladen kann / darf.

    Ok, ich verstehe schon das mit dem Vergleich, aber ich verstehe nicht genau wo was steht.
    Was steht in Zeile 1-12 in welchen Spalten für KPI Direct Project Cost"?
    Das ist meine Signatur und sie wird wunderbar sein!

    Sorry, bei mir dauert heute das mit dem Verständnis etwas länger.
    Also die KPIs stehen in der Spalte A1:A29
    Die Monatswerte stehen in den Bereichen B1:M29. Wobei in der ersten Zeile die Namen der Monate stehen und in den jeweilgen Zeilen die entsprechenden Wert

    		Januar
    		Februar
    		März
    Labour Charged by Hourly Rate
    		1.000
    		2.000
    		0
    Internal Service Costs
    		-5.000
    		-7.000
    		0
    Direct Project Costs
    		-2.000
    		0
    		0
    ...




    Ziel:


    		10% Abweiung zum Vormonat
    (Febr. zu Jan), wenn Ja dann Wert der Abweichung in %
    Labour Charged by Hourly Rate
    		+ X %
    Internal Service Costs
    		- X %
    Direct Project Costs
    		- X %


    Hoffe die Tabellen helfen weiter.

    Schöne Grüße

    Jörg

    Dieser Beitrag wurde bereits 2 mal editiert, zuletzt von „joerg_W“ ()

    Ok ich habe es denke ich verstanden.


    Versuch mal das:

    Visual Basic-Quellcode

    1. ​
    2. Sub FindKPI()
    3. Dim lastrow As Long
    4. Dim a As Long, b As Long, diff As Double
    5. lastrow = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
    6. 'zeilen
    7. For a = 2 To lastrow
    8. 'spalten
    9. For b = 2 To 12 'spalte 13 is letze, da kommt keine zum vergleichen
    10. 'diff zwischen den Monaten
    11. diff = Sheets("Sheet1").Cells(a, b + 1) - Sheets("Sheet1").Cells(a, b)
    12. If Sheets("Sheet1").Cells(a, b) = 0 And diff <> 0 Then
    13. Sheets("Sheet2").Cells(a, 1) = Cells(a, 1) 'kpi
    14. Sheets("Sheet2").Cells(a, b) = "100 %" 'wert
    15. ElseIf diff <> 0 And Sheets("Sheet1").Cells(a, b + 1) = 0 Then
    16. Sheets("Sheet2").Cells(a, 1) = Cells(a, 1) 'kpi
    17. Sheets("Sheet2").Cells(a, b) = "-100 %" 'wert
    18. ElseIf diff <> 0 Then
    19. If Abs(diff / Cells(a, b)) >= 0.1 Then
    20. Sheets("Sheet2").Cells(a, 1) = Cells(a, 1) 'kpi
    21. Sheets("Sheet2").Cells(a, b) = CStr(diff / Abs(Cells(a, b)) * 100) & " %"
    22. End If
    23. End If
    24. Next
    25. Next
    26. End Sub



    Ich hab einfach angenommen, dass bei 0 die Differenz dann immer 100% ist (entweder - oder +)
    Das ist meine Signatur und sie wird wunderbar sein!

    Hallo Mono,

    super - vielen Dank! Jetzt sieht es so aus, wie es sein sollte. Bei den %-Berechnungen muss noch etwas angpasst werden (710866073741473%), aber das krieg ich hin.

    Nochmals 1.000 Dank für alles und hoffentlich bis bald mal wieder.

    Schöne Grüße

    Jörg

Facebook
Telefonspende