VBA-Forum - Das Forum zu Microsoft VBA

VBA Excel VBA Word VBA Access VBA VBScript VB C# Objective-C C++ SQL JAVA VBA (English) Jobs Übersicht

Thema	Datum	Von Nutzer	Rating	Antwort
Berechnung durchführen	23.05.2023 10:04:15	Arthur
Berechnung durchführen	23.05.2023 10:34:12	Gast20230
Berechnung durchführen	23.05.2023 10:52:00	Gast32987
Berechnung durchführen	23.05.2023 11:54:07	Gast77902

Ansicht des Beitrags:

Von:
Arthur

Datum:
23.05.2023 10:04:15

Views:
1592

Rating:

Antwort:

Thema:
Berechnung durchführen

Hallo zusammen,

eines vorweg: Ich bin total neu in dem Bereich VBA und versuche mir das gerade selbst beizubringen.

Ich benutze die deutsche Excel Version 2208 Build 16.0.15601.20644 in 64 Bit

Ausgangslage:

Ich habe ein Tabellenblatt ("Working Sheet") in dem ich basierend auf verschiedenen Bedingungen eine Berechnung in Spalte AX durchführen möchte.

In Spalte AB ist der Ausgangswert (ein Geldbetrag z.B. 1,10 der als "Standard" formatiert ist und kein Eurozeichen hat)

In Spalte AK ist ein Absoluter Wert (z.B. 60)

In Spalte AM und AN sind wie in Spalte AB Geldbeträge, die wie Spalte AB aufgebaut sind (Standard-Format und ohne Eurozeichen).

In Spalte AT ist ein eine Zahl mit bis zu 2 Nachkommastellen, die auch als Standard formatiert ist.

In Spalte AW steht eine Zahl zwischen 1 und 10, ebenfalls wieder als Standard formatiert (dies bezieht sich auf die Nummer der Regel).

Folgendes will ich mittesl Makro machen:

In Spalte AX soll in die erste Zeile "Neuer Wert" eingetragen werden.

Für alle anderen Zeilen soll geprüft werden, welcher Wert in Spalte AW steht. Ist dort zum Beispiel eine 1, dann soll diese Formel angewendet werden:

=WENNFEHLER(WENN(UND(AK2>20;AN2=0);RUNDEN(AB2*0,1;2);
WENN(UND(AK2>15;AK2<=20;AN2=0;AM2>30);RUNDEN(AB2*0,6;2);
WENN(UND(AK2>10;AK2<=15;AN2=0;AM2>30);RUNDEN(AB2*0,75;2);
WENN(UND(AK2>5;AK2<=10;AN2=0;AM2>30);RUNDEN(AB2*0,9;2);
WENN(UND(AK2<=5);AB2;
WENN(UND(AT2<=1;AK2>15);RUNDEN(AB2*0,3;2);
WENN(UND(AT2<=1;AK2<=15;AK2>5);RUNDEN(AB2*0,4;2);
WENN(UND(AT2<=1;AK2<=5);AB2;
WENN(UND(AT2>1;AT2<=2;AK2>15);RUNDEN(AB2*0,55;2);
WENN(UND(AT2>1;AT2<=2;AK2<=15;AK2>5);RUNDEN(AB2*0,6;2);
WENN(UND(AT2>1;AT2<=2;AK2<=5);AB2;
WENN(UND(AT2>2;AT2<=3;AK2>15);RUNDEN(AB2*0,65;2);
WENN(UND(AT2>2;AT2<=3;AK2<=15;AK2>5);RUNDEN(AB2*0,7;2);
WENN(UND(AT2>2;AT2<=3;AK2<=5);AB2;
WENN(UND(AT2>3;AT2<=5;AK2>15);RUNDEN(AB2*0,8;2);
WENN(UND(AT2>3;AT2<=5;AK2<=15;AK2>5);RUNDEN(AB2*0,85;2);
WENN(UND(AT2>3;AT2<=5;AK2<=5);AB2;
WENN(UND(AT2>5;AT2<=8;AK2>15);RUNDEN(AB2*0,9;2);
WENN(UND(AT2>5;AT2<=8;AK2<=15;AK2>5);RUNDEN(AB2*0,93;2);
WENN(UND(AT2>5;AT2<=8;AK2<=5);AB2;
WENN(UND(AT2>8;AT2<=10;AK2>15);RUNDEN(AB2*0,95;2);
WENN(UND(AT2>8;AT2<=10;AK2<=15;AK2>5);RUNDEN(AB2*0,97;2);
WENN(UND(AT2>8;AT2<=10;AK2<=5);AB2;
WENN(UND(AT2>10;AT2<=20);AB2;
WENN(AT2>20;RUNDEN(AB2*1,05;2);AB2)))))))))))))))))))))))));"")

Wenn in AW eine 2 steht, dann soll eine ähnliche Formel mit leicht anderen Werten angewendet werden usw.

Also für jeden Wert von 1 bis 10 in Spalte AW soll eine andere Formel angewendet werden.

Um mich heranzutesten, habe ich erstmal nur versucht ein Makro für den Wert "3" in AW geschrieben, wenn ich das Makro aber ausführe, dann wird zwar in die erste Zeile "neuer Wert" geschrieben, aber alle übrigen Zeilen der Spalte AX bleiben leer.

Was mache ich falsch?

Sub MakroDeutsch()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
     
    ' Tabellenblatt "Working Sheet" auswählen
    Set ws = ThisWorkbook.Sheets("Working Sheet")
     
    ' Letzte Zeile in Spalte AX ermitteln
    lastRow = ws.Cells(ws.Rows.Count, "AX").End(xlUp).Row
     
    ' "neuer Wert" in die erste Zeile von Spalte AX eintragen
    ws.Range("AX1").Value = "neuer Wert"
     
    ' Logik für alle anderen Zeilen anwenden
    For i = 2 To lastRow
        If ws.Cells(i, "AW").Value = 3 Then
            If ws.Cells(i, "AK").Value > 30 And ws.Cells(i, "AN").Value = 0 Then
                ws.Cells(i, "AX").Value = ws.Cells(i, "AB").Value * 0.9
            ElseIf ws.Cells(i, "AK").Value > 18 And ws.Cells(i, "AK").Value <= 30 And ws.Cells(i, "AN").Value = 0 And ws.Cells(i, "AM").Value > 30 Then
                ws.Cells(i, "AX").Value = ws.Cells(i, "AB").Value * 0.75
            ElseIf ws.Cells(i, "AK").Value <= 18 And ws.Cells(i, "AK").Value > 10 And ws.Cells(i, "AN").Value = 0 And ws.Cells(i, "AM").Value > 30 Then
                ws.Cells(i, "AX").Value = ws.Cells(i, "AB").Value * 0.82
            ElseIf ws.Cells(i, "AK").Value <= 10 And ws.Cells(i, "AK").Value > 5 And ws.Cells(i, "AN").Value = 0 And ws.Cells(i, "AM").Value > 30 Then
                ws.Cells(i, "AX").Value = ws.Cells(i, "AB").Value * 0.89
            ElseIf ws.Cells(i, "AK").Value >= 1 And ws.Cells(i, "AK").Value <= 5 And ws.Cells(i, "AN").Value = 0 Then
                ws.Cells(i, "AX").Value = ws.Cells(i, "AB").Value
            ElseIf ws.Cells(i, "AT").Value <= 1 And ws.Cells(i, "AK").Value > 15 Then
                ws.Cells(i, "AX").Value = ws.Cells(i, "AB").Value * 0.65
            ElseIf ws.Cells(i, "AT").Value <= 1 And ws.Cells(i, "AK").Value > 5 And ws.Cells(i, "AK").Value <= 15 Then
                ws.Cells(i, "AX").Value = ws.Cells(i, "AB").Value * 0.75
            ElseIf ws.Cells(i, "AT").Value <= 1 And ws.Cells(i, "AK").Value <= 5 Then
                ws.Cells(i, "AX").Value = ws.Cells(i, "AB").Value
            ElseIf ws.Cells(i, "AT").Value > 1 And ws.Cells(i, "AT").Value <= 2 And ws.Cells(i, "AK").Value > 20 Then
                ws.Cells(i, "AX").Value = ws.Cells(i, "AB").Value * 0.8
            ElseIf ws.Cells(i, "AT").Value > 1 And ws.Cells(i, "AT").Value <= 2 And ws.Cells(i, "AK").Value <= 19 And ws.Cells(i, "AK").Value > 10 Then
                ws.Cells(i, "AX").Value = ws.Cells(i, "AB").Value * 0.87
            ElseIf ws.Cells(i, "AT").Value > 1 And ws.Cells(i, "AT").Value <= 2 And ws.Cells(i, "AK").Value <= 10 Then
                ws.Cells(i, "AX").Value = ws.Cells(i, "AB").Value
            ElseIf ws.Cells(i, "AT").Value > 2 And ws.Cells(i, "AT").Value <= 3.2 And ws.Cells(i, "AK").Value > 20 Then
                ws.Cells(i, "AX").Value = ws.Cells(i, "AB").Value * 0.88
            ElseIf ws.Cells(i, "AT").Value > 2 And ws.Cells(i, "AT").Value <= 3.2 And ws.Cells(i, "AK").Value <= 19 And ws.Cells(i, "AK").Value > 10 Then
                ws.Cells(i, "AX").Value = ws.Cells(i, "AB").Value * 0.9
            ElseIf ws.Cells(i, "AT").Value > 2 And ws.Cells(i, "AT").Value <= 3.2 And ws.Cells(i, "AK").Value <= 10 Then
                ws.Cells(i, "AX").Value = ws.Cells(i, "AB").Value
            ElseIf ws.Cells(i, "AT").Value > 3.2 And ws.Cells(i, "AT").Value <= 5 Then
                ws.Cells(i, "AX").Value = ws.Cells(i, "AB").Value
            ElseIf ws.Cells(i, "AT").Value > 5 And ws.Cells(i, "AT").Value <= 6 Then
                ws.Cells(i, "AX").Value = ws.Cells(i, "AB").Value * 1.05
            ElseIf ws.Cells(i, "AT").Value > 6 And ws.Cells(i, "AT").Value <= 8 Then
                ws.Cells(i, "AX").Value = ws.Cells(i, "AB").Value * 1.1
            ElseIf ws.Cells(i, "AT").Value > 8 And ws.Cells(i, "AT").Value <= 20 Then
                ws.Cells(i, "AX").Value = ws.Cells(i, "AB").Value * 1.2
            ElseIf ws.Cells(i, "AT").Value > 20 Then
                ws.Cells(i, "AX").Value = ws.Cells(i, "AB").Value * 1.3
            End If
        End If
    Next i
End Sub

Ihre Antwort

Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema:		Name:		Email:
WYSIWYG-Editor, ctl00_Content_editor1 Editor WerkzeugleistenDokument Quellcode VorschauZwischenablage/Rückgängig AusschneidenTastaturkürzel Strg+X KopierenTastaturkürzel Strg+C EinfügenTastaturkürzel Strg+V Als Klartext einfügenTastaturkürzel Strg+Alt+Umschalt+V Aus Word einfügen RückgängigTastaturkürzel Strg+Z WiederherstellenTastaturkürzel Strg+YEditieren Suchen Ersetzen Alles auswählenGrundstile FettTastaturkürzel Strg+B KursivTastaturkürzel Strg+I UnterstrichenTastaturkürzel Strg+U Durchgestrichen Formatierung entfernenAbsatz Nummerierte Liste einfügen/entfernen Liste Einzug verringern Einzug erhöhen Zitatblock Linksbündig Zentriert Rechtsbündig BlocksatzLinks Link einfügen/editierenTastaturkürzel Strg+K Link entfernen AnkerEinfügen Bild Tabelle Horizontale Linie einfügen Smiley Sonderzeichen einfügen Einen Quelltextabschnitt einfügen oder aktualisierenStileFormatFormatSchriftartSchriftartGrößeGrößeFarben Textfarbe HintergrundfarbeWerkzeuge Maximieren Blöcke anzeigenabout Über CKEditor 4 Drücken Sie ALT 0 für Hilfe

Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema	Datum	Von Nutzer	Rating	Antwort
Berechnung durchführen	23.05.2023 10:04:15	Arthur
Berechnung durchführen	23.05.2023 10:34:12	Gast20230
Berechnung durchführen	23.05.2023 10:52:00	Gast32987
Berechnung durchführen	23.05.2023 11:54:07	Gast77902