Microsoft Excel

Herbers Excel/VBA-Archiv

Minus rechnen und dann löschen

Betrifft: Minus rechnen und dann löschen von: René
Geschrieben am: 25.03.2020 08:26:13

Liebe Excel Gemeinde


Folgende Aufgabe hätte ich.

In Tabelle 2 Spalte B5 habe ich eine Gesamtmenge. Diese wird aus Tabelle 1 übernommen. Nun Produzieren wir an verschiedenen Maschinen, die Tagesleistung wir in Tabelle 2 Spalten D5-J5 eingetragen. Jetzt möchte ich die Tagesleistungen von den Spalten D5-J5 von der Spalte B5 (Gesamtmenge) minus rechnen und in Spalte C5 (Restmenge) eintragen. Jetzt die knifflige Aufgabe. Die Tagesleistungen (Spalten D5-J5 ) sollten danach gelöscht werden ohne dass das Resultat in Spalte C5 (Restmenge) geändert wird weil ich möchte wissen, wann haben wir die Gesamtmenge erreicht. Super wäre ein Makros wo ich dann mittels Button verknüpfen kann.

Hoffe das versteht jemand und ich habe es einigermassen richtig erklärt.


Hier die Tabelle: https://www.herber.de/bbs/user/136087.xlsx

Betrifft: AW: Bitte Hans W. Herber ...
von: Sulprobil
Geschrieben am: 25.03.2020 09:47:08

schnellstmöglich Deine Echtdaten zu löschen, rate ich.
Anonymisiere Deine Daten und lade sie erneut hoch.

Viele Grüße,
Bernd P

Betrifft: AW: Hier ein Beispielmakro
von: Sulprobil
Geschrieben am: 25.03.2020 10:13:07

Hallo René,
Option Explicit

Sub Restmenge_ermitteln()
Dim i As Long, d As Double, dSum As Double
With Sheets("Tabelle2")
i = 5 'Starte ab Zeile 5 - man könnte auch nach dem Stichwort "Aufträge" in Spalte A suchen  _
lassen
Do While .Cells(i, 1) <> "Total" And .Cells(i, 1) <> "Folieren" ' And Not IsEmpty(.Cells(i, 3))
    If .Cells(i, 1) <> 0 Then
        d = IIf(IsEmpty(.Cells(i, 3)), .Cells(i, 2), .Cells(i, 3)) _
            - Application.WorksheetFunction.Sum(.Range(.Cells(i, 4), .Cells(i, 10)))
        .Cells(i, 3) = d
        dSum = dSum + d
        .Range(.Cells(i, 4), .Cells(i, 10)).ClearContents
    End If
    i = i + 1
Loop
If .Cells(i, 1) = "Total" Then .Cells(i, 3) = dSum
End With
End Sub
Viele Grüße,
Bernd P

Betrifft: AW: Minus rechnen und dann löschen
von: René
Geschrieben am: 25.03.2020 11:38:10

Hallo Sulprobi
Man sieht schon dass ich ein Anfänger bin, VIELE Dank für die Hilfe.
Noch eine Frage? Wenn ich jetzt mehr Maschinen hätte und nebst Spalte D - J noch eine Spalte dazu käme, wo müsste ich überall das Makro anpassen?
Nochmals Vielen Dank, funktioniert einwandfrei.
Nb. Die Daten sind nicht heikel und von Nutzen für jemanden.

Betrifft: AW: Auführlicheres Makro
von: Sulprobil
Geschrieben am: 25.03.2020 12:54:45

Hallo René,

Für neue oder veränderte Spalten musst Du nun lediglich die Enumerierung ändern - also ggf- einfach zwischen J und K eine neue Spalte einfügen und zwischen stMaschine8 und stUBound eine stMaschine9 einfügen.
Option Explicit

Enum Spalten_in_Tabelle2
    stLBound = 0 'Damit wir ggf. von stLBound + 1 iterieren können
    stAuftraege = 1 '= 1 kann man weglassen, der nächste Eintrag bekommt immer 1 dazu
    stGesamtmenge
    stRestmenge 'Die Maschinen sind alle von stRestmenge + 1 bis stUbound - 1
    stMaschine2
    stMaschine3
    stMaschine4
    stMaschine5
    stMaschine6
    stMaschine7
    stMaschine8
    stUBound 'Damit wir bis stUBound - 1 iterieren können
End Enum

Sub Restmenge_ermitteln()
Dim i As Long, dRest As Double, dTotal As Double
With Sheets("Tabelle2")
i = 5 'Starte ab Zeile 5 - man könnte auch nach dem Stichwort "Aufträge" in Spalte A suchen _
lassen
'Nun laufen wir von Zeile 5 hinunter bis wir auf Total stoßen (zur Sicherheit wollen wir nie in  _
den Bereich Folieren gelangen!)
Do While .Cells(i, stAuftraege) <> "Total" And .Cells(i, stAuftraege) <> "Folieren" ' And Not  _
IsEmpty(.Cells(i, stRestmenge))
    If .Cells(i, stAuftraege) <> 0 Then 'Die Nullen in Spalte sollte man möglichst löschen,  _
aber wir ignorieren sie erst einmal
        'Wenn wir bereits eine Restmenge haben, ziehen wir davon ab, ansonsten starten wir mit  _
der Gesamtmenge
        dRest = IIf(IsEmpty(.Cells(i, stRestmenge)), .Cells(i, stGesamtmenge), .Cells(i,  _
stRestmenge)) _
            - Application.WorksheetFunction.Sum(.Range(.Cells(i, stRestmenge + 1), .Cells(i,  _
stUBound - 1)))
        .Cells(i, stRestmenge) = dRest
        dTotal = dTotal + dRest
        .Range(.Cells(i, stRestmenge + 1), .Cells(i, stUBound - 1)).ClearContents
    End If
    i = i + 1
Loop
If .Cells(i, stAuftraege) = "Total" Then .Cells(i, stRestmenge) = dTotal
End With
End Sub
Have fun,
Bernd P

Betrifft: AW: Minus rechnen und dann löschen
von: René
Geschrieben am: 25.03.2020 13:52:44

Vielen Dank Sulprobi und wenn ich dann noch Fragen habe oder Erweitern möchte melde ich mich gerne wieder!

Gruss René

Betrifft: AW: Minus rechnen und dann löschen
von: René
Geschrieben am: 27.03.2020 16:15:58

Hallo Sulprobi
Darf ich noch etwas Fragen? Das Makro funktioniert super, wenn ich aber die Mappe Schreibschütze kommt ein Laufzeitfehler 400. Kann ich da etwas machen dassder fehler nicht kommt?

Beiträge aus dem Excel-Forum zum Thema "Minus rechnen und dann löschen"