VBA Makro per button ausführen

Question

Hallo zusammen,

Ich habe einen Button erstellt und diesem ein Makro zugewiesen, welches bei dem Wert „Ja“ neue Zeilen einfügt und diese Formatiert. Dies läuft auch einwandfrei. Wenn ich aber erneut auf den Button klicke, fügt das Makro die gleichen Zeilen erneut ein. Ich möchte aber, dass jede Zeile in der ein „Ja“ vorkommt nur einmal auf der neu generierten liste erscheint. D.h. beim 2. Klicken auf den Button soll die generierte Liste quasi nur noch aktualisiert werden. Dasselbe gilt wenn man ein „ja“ wieder entfernt, soll es aus der bereits generierten Liste wieder verschwinden.
Ich hoff ihr könnt mir helfen!

Hier mein Makro:

Sub Makro3()
Dim rCell As Range
Dim rRng As Range
Dim lzeile As Long
Set rRng = Worksheets("Verkaufsgruppen").Range("D3:D215")

'Zellen im Bereich nach Ja durchsuchen
For Each rCell In rRng.Cells

'Prüfen ob Zellinhalt Ja ist
If rCell.Value = "Ja" Then

'falls ja, dann
With Sheets("Giesserei")
.Range("A5:A7").EntireRow.Insert 'Zeilen einfügen
.Cells(5, 2) = "VOK" 'Text einfügen
.Cells(6, 2) = "BEMI"
.Cells(7, 2) = "Invest"

With .Range("A5:A7") 'Spalte A formatieren
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.ReadingOrder = xlContext
.MergeCells = True
End With

'Name aus dem Blatt Verkaufsgruppen einfügen
.Range("A5") = Worksheets("Verkaufsgruppen").Cells(rCell.Row, 2)

End With

End If

Next rCell

'letzte beschriebene Zeile in Spalte B ermitteln für Summen
lzeile = Sheets("Giesserei").Cells(Rows.Count, 2).End(xlUp).Row

'Summewenn-Formeln einfügen; letzte Zeilen in Tabelle Giesserei
With Sheets("Giesserei")
.Cells(lzeile + 1, 3).FormulaLocal = "=SUMMEWENN(B5:B" & lzeile & ";""VOK"";C5:C" & lzeile & ")"
.Cells(lzeile + 2, 3).FormulaLocal = "=SUMMEWENN(B5:B" & lzeile & ";""BEMI"";C5:C" & lzeile & ")"
.Cells(lzeile + 3, 3).FormulaLocal = "=SUMMEWENN(B5:B" & lzeile & ";""Invest"";C5:C" & lzeile & ")"
End With

End Sub

Mit freundlichen grüßen peyd

Answer 1

Hallo,

ahh okay, so langsam kommt Licht ins Dunkle, aber leider noch nicht genug -.- Also ich habe jetzt das Array wieder auf lzeile -4 gesetzt. Die Fehlermeldung taucht allerdings immer noch auf. (Laut Debugger im FETT makierten Bereich).

Das ganze schaut jetzt so aus:

If pruef = True Then
'Feld neu dimensionieren
ReDim ArrayC(lzeile - 4, 7)

'Daten aus Tabelle Giesserei, Spalte C in das Feld einlesen

For zeile = 5 To lzeile Step 4 ' ab Zeile 5 alle 4 Zeilen wiederholen


ArrayC(zeile - 4, 0) = Worksheets("Giesserei").Cells(zeile, 1).Value 'Name in Array schreiben

For z = 0 To 2
For s = 1 To 7
ArrayC(zeile - 4 + z, s) = Worksheets("Giesserei").Cells(zeile + z, 2 + s).Value 'Werte der Spalten C bis I in Array schreiben
Next s
Next z

Next zeile

'Nun Inhalt des Blattes Giesserei löschen
lzeile = Worksheets("Giesserei").Cells(Rows.Count, 2).End(xlUp).Row
With Worksheets("Giesserei")
.Range(.Cells(5, 1), .Cells(lzeile, 3)).EntireRow.Delete
End With

End If
...

'Vorhandene Daten ggf. wieder in Tabelle Giesserei schreiben

If pruef = True Then

zeile = 5

For j = 1 To lzeile Step 4

For i = 1 To UBound(ArrayC) Step 4

If Worksheets("Giesserei").Cells(zeile, 1).Value = ArrayC(i, 0) Then


For z = 0 To 2
For s = 1 To 7
Worksheets("Giesserei").Cells(zeile + z, 2 + s) = ArrayC(i + z, s) 'Werte der Spalten C bis I aus Array in Tabelle schreiben
Next s
Next z



Wenn ich das Array auf lzeile-3 festlege, funktioniert das Makro zwar aber es löscht mir die ersten beiden Summenformeln am ende der Tabelle. Kann mir das leider nicht erklären... Theoretisch ändert sich an der Tabelle nicht viel, es wird jediglich eine Zeile eingefügt und unten in der Tabelle steht eine Summenformel mehr. Also müsste man doch im Makro nur den Bereich neu festlegen und es müsste gehen?

Sorry für meine Unkenntnis!

LG peyd

Answer 2

Hallo peyd,

was mir beim drüberlesen auffällt, ist folgendes:
Du hast zwar die Zeile

For zeile = 5 To lzeile Step 4 ' ab Zeile 5 alle 4 Zeilen wiederholen

angepasst, aber weiter unten beim Ein- und Auslesen der Daten hast es vergessen. Da steht immer noch:

For z = 0 To 2

Damit werden also nur 3 Zeilen eingelesen, das müsstest du ändern in

For z = 0 To 3

Welche Fehlermeldung kommt denn? Immer noch die mit dem Index.

Gruß

M.O.

Answer 3

Hallo M.O.,

Stimmt das hatte ich vergessen. Der Fehler lautet "Index außerhalb des gültigen Bereichs"

Hier nochmal das komplette Makro, vllt. fällt dir ja beim überlesen der Gesamtheit noch irgendwo ein Fehler auf:

Sub Makro_Giesserei()

Dim rCell As Range
Dim rRng As Range
Dim lzeile As Long
Dim ArrayC() As Variant
Dim zeile As Long
Dim i As Long
Dim j As Long
Dim pruef As Boolean
Dim z As Long
Dim s As Long


'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False

'Anzahl der Datensätze in Tabelle Giesserei ermitteln
lzeile = Sheets("Giesserei").Cells(Rows.Count, 2).End(xlUp).Row

'prüfen, ob letzte Zeile größer 4

If lzeile < 5 Then
pruef = False
Else
pruef = True
End If

If pruef = True Then
'Feld neu dimensionieren
ReDim ArrayC(lzeile - 4, 7)

'Daten aus Tabelle Giesserei, Spalte C in das Feld einlesen

For zeile = 5 To lzeile Step 4 ' ab Zeile 5 alle 4 Zeilen wiederholen


ArrayC(zeile - 4, 0) = Worksheets("Giesserei").Cells(zeile, 1).Value 'Name in Array schreiben

For z = 0 To 3
For s = 1 To 7
ArrayC(zeile - 4 + z, s) = Worksheets("Giesserei").Cells(zeile + z, 3 + s).Value 'Werte der Spalten C bis I in Array schreiben
Next s
Next z

Next zeile

'Nun Inhalt des Blattes Giesserei löschen
lzeile = Worksheets("Giesserei").Cells(Rows.Count, 2).End(xlUp).Row
With Worksheets("Giesserei")
.Range(.Cells(5, 1), .Cells(lzeile, 3)).EntireRow.Delete
End With

End If

'Tabellenblatt Giesserei neu aufbauen
Set rRng = Worksheets("Verkaufsgruppen").Range("D3:D215")

'Zellen im Bereich nach Ja durchsuchen
For Each rCell In rRng.Cells

'Prüfen ob Zellinhalt Ja ist
If rCell.Value = "Ja" Then

'falls ja, dann
With Sheets("Giesserei")
.Range("A5:A8").EntireRow.Insert 'Zeilen einfügen
.Cells(5, 2) = "Anlaufkosten"
.Cells(6, 2) = "VOK" 'Text einfügen
.Cells(7, 2) = "BEMI"
.Cells(8, 2) = "Invest"
.Cells(5, 10) = "=SUM(RC[-7]:RC[-1])" 'Zeilensummen Spalte J bilden
.Cells(6, 10) = "=SUM(RC[-7]:RC[-1])"
.Cells(7, 10) = "=SUM(RC[-7]:RC[-1])"
.Cells(8, 10) = "=SUM(RC[-7]:RC[-1])"

With .Range("A5:A8") 'Spalte A formatieren
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.ReadingOrder = xlContext
.MergeCells = True
End With

'Name aus dem Blatt Verkaufsgruppen einfügen
.Range("A5") = Worksheets("Verkaufsgruppen").Cells(rCell.Row, 2)

End With

End If

Next rCell

'letzte beschriebene Zeile in Spalte B ermitteln
lzeile = Worksheets("Giesserei").Cells(Rows.Count, 2).End(xlUp).Row


'Vorhandene Daten ggf. wieder in Tabelle Giesserei schreiben

If pruef = True Then

zeile = 5

For j = 1 To lzeile Step 4

For i = 1 To UBound(ArrayC) Step 4

If Worksheets("Giesserei").Cells(zeile, 1).Value = ArrayC(i, 0) Then


For z = 0 To 3
For s = 1 To 7
Worksheets("Giesserei").Cells(zeile + z, 2 + s) = ArrayC(i + z, s) 'Werte der Spalten C bis I aus Array in Tabelle schreiben
Next s
Next z


End If

Next i

zeile = zeile + 4

Next j

End If

'Summewenn-Formeln einfügen; letzte Zeilen in Tabelle Giesserei
With Sheets("Giesserei")
.Cells(lzeile + 1, 3).FormulaLocal = "=SUMMEWENN(B5:B" & lzeile & ";""Anlaufkosten"";C5:C" & lzeile & ")"
.Cells(lzeile + 2, 3).FormulaLocal = "=SUMMEWENN(B5:B" & lzeile & ";""VOK"";C5:C" & lzeile & ")"
.Cells(lzeile + 3, 3).FormulaLocal = "=SUMMEWENN(B5:B" & lzeile & ";""BEMI"";C5:C" & lzeile & ")"
.Cells(lzeile + 4, 3).FormulaLocal = "=SUMMEWENN(B5:B" & lzeile & ";""Invest"";C5:C" & lzeile & ")"

.Cells(lzeile + 1, 4).FormulaLocal = "=SUMMEWENN(B5:B" & lzeile & ";""Anlaufkosten"";D5:D" & lzeile & ")"
.Cells(lzeile + 2, 4).FormulaLocal = "=SUMMEWENN(B5:B" & lzeile & ";""VOK"";D5:D" & lzeile & ")"
.Cells(lzeile + 3, 4).FormulaLocal = "=SUMMEWENN(B5:B" & lzeile & ";""BEMI"";D5:D" & lzeile & ")"
.Cells(lzeile + 4, 4).FormulaLocal = "=SUMMEWENN(B5:B" & lzeile & ";""Invest"";D5:D" & lzeile & ")"

.Cells(lzeile + 1, 5).FormulaLocal = "=SUMMEWENN(B5:B" & lzeile & ";""Anlaufkosten"";E5:E" & lzeile & ")"
.Cells(lzeile + 2, 5).FormulaLocal = "=SUMMEWENN(B5:B" & lzeile & ";""VOK"";E5:E" & lzeile & ")"
.Cells(lzeile + 3, 5).FormulaLocal = "=SUMMEWENN(B5:B" & lzeile & ";""BEMI"";E5:E" & lzeile & ")"
.Cells(lzeile + 4, 5).FormulaLocal = "=SUMMEWENN(B5:B" & lzeile & ";""Invest"";E5:E" & lzeile & ")"

.Cells(lzeile + 1, 6).FormulaLocal = "=SUMMEWENN(B5:B" & lzeile & ";""Anlaufkosten"";F5:F" & lzeile & ")"
.Cells(lzeile + 2, 6).FormulaLocal = "=SUMMEWENN(B5:B" & lzeile & ";""VOK"";F5:F" & lzeile & ")"
.Cells(lzeile + 3, 6).FormulaLocal = "=SUMMEWENN(B5:B" & lzeile & ";""BEMI"";F5:F" & lzeile & ")"
.Cells(lzeile + 4, 6).FormulaLocal = "=SUMMEWENN(B5:B" & lzeile & ";""Invest"";F5:F" & lzeile & ")"

.Cells(lzeile + 1, 7).FormulaLocal = "=SUMMEWENN(B5:B" & lzeile & ";""Anlaufkosten"";G5:G" & lzeile & ")"
.Cells(lzeile + 2, 7).FormulaLocal = "=SUMMEWENN(B5:B" & lzeile & ";""VOK"";G5:G" & lzeile & ")"
.Cells(lzeile + 3, 7).FormulaLocal = "=SUMMEWENN(B5:B" & lzeile & ";""BEMI"";G5:G" & lzeile & ")"
.Cells(lzeile + 4, 7).FormulaLocal = "=SUMMEWENN(B5:B" & lzeile & ";""Invest"";G5:G" & lzeile & ")"

.Cells(lzeile + 1, 8).FormulaLocal = "=SUMMEWENN(B5:B" & lzeile & ";""Anlaufkosten"";H5:H" & lzeile & "

Answer 4

Hallo peyd,

was mir nur aufgefallen ist, dass die Zuordnung der eingelesenen Datei beim Zurückschreiben in die Datei nicht stimmt. Das habe ich verbessert:

[code]Sub Makro_Giesserei()

Dim rCell As Range
Dim rRng As Range
Dim lzeile As Long
Dim ArrayC() As Variant
Dim zeile As Long
Dim i As Long
Dim j As Long
Dim pruef As Boolean
Dim z As Long
Dim s As Long


'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False

'Anzahl der Datensätze in Tabelle Giesserei ermitteln
lzeile = Sheets("Giesserei").Cells(Rows.Count, 2).End(xlUp).Row

'prüfen, ob letzte Zeile größer 4

If lzeile < 5 Then
pruef = False
Else
pruef = True
End If

If pruef = True Then
'Feld neu dimensionieren
ReDim ArrayC(lzeile - 4, 7)

'Daten aus Tabelle Giesserei, Spalte C in das Feld einlesen

For zeile = 5 To lzeile Step 4 ' ab Zeile 5 alle 4 Zeilen wiederholen


ArrayC(zeile - 4, 0) = Worksheets("Giesserei").Cells(zeile, 1).Value 'Name in Array schreiben

For z = 0 To 3
For s = 1 To 7
ArrayC(zeile - 4 + z, s) = Worksheets("Giesserei").Cells(zeile + z, 2 + s).Value 'Werte der Spalten C bis I in Array schreiben
Next s
Next z

Next zeile

'Nun Inhalt des Blattes Giesserei löschen
lzeile = Worksheets("Giesserei").Cells(Rows.Count, 2).End(xlUp).Row
With Worksheets("Giesserei")
.Range(.Cells(5, 1), .Cells(lzeile, 3)).EntireRow.Delete
End With

End If

'Tabellenblatt Giesserei neu aufbauen
Set rRng = Worksheets("Verkaufsgruppen").Range("D3:D215")

'Zellen im Bereich nach Ja durchsuchen
For Each rCell In rRng.Cells

'Prüfen ob Zellinhalt Ja ist
If rCell.Value = "Ja" Then

'falls ja, dann
With Sheets("Giesserei")
.Range("A5:A8").EntireRow.Insert 'Zeilen einfügen
.Cells(5, 2) = "Anlaufkosten"
.Cells(6, 2) = "VOK" 'Text einfügen
.Cells(7, 2) = "BEMI"
.Cells(8, 2) = "Invest"
.Cells(5, 10) = "=SUM(RC[-7]:RC[-1])" 'Zeilensummen Spalte J bilden
.Cells(6, 10) = "=SUM(RC[-7]:RC[-1])"
.Cells(7, 10) = "=SUM(RC[-7]:RC[-1])"
.Cells(8, 10) = "=SUM(RC[-7]:RC[-1])"

With .Range("A5:A8") 'Spalte A formatieren
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.ReadingOrder = xlContext
.MergeCells = True
End With

'Name aus dem Blatt Verkaufsgruppen einfügen
.Range("A5") = Worksheets("Verkaufsgruppen").Cells(rCell.Row, 2)

End With

End If

Next rCell

'letzte beschriebene Zeile in Spalte B ermitteln
lzeile = Worksheets("Giesserei").Cells(Rows.Count, 2).End(xlUp).Row


'Vorhandene Daten ggf. wieder in Tabelle Giesserei schreiben

If pruef = True Then

zeile = 5

For j = 1 To lzeile Step 4

For i = 1 To UBound(ArrayC) Step 4

If Worksheets("Giesserei").Cells(zeile, 1).Value = ArrayC(i, 0) Then


For z = 0 To 3
For s = 1 To 7
Worksheets("Giesserei").Cells(zeile + z, 2 + s) = ArrayC(i + z, s) 'Werte der Spalten C bis I aus Array in Tabelle schreiben
Next s
Next z


End If

Next i

zeile = zeile + 4

Next j

End If

'Summewenn-Formeln einfügen; letzte Zeilen in Tabelle Giesserei
With Sheets("Giesserei")
.Cells(lzeile + 1, 3).FormulaLocal = "=SUMMEWENN(B5:B" & lzeile & ";""Anlaufkosten"";C5:C" & lzeile & ")"
.Cells(lzeile + 2, 3).FormulaLocal = "=SUMMEWENN(B5:B" & lzeile & ";""VOK"";C5:C" & lzeile & ")"
.Cells(lzeile + 3, 3).FormulaLocal = "=SUMMEWENN(B5:B" & lzeile & ";""BEMI"";C5:C" & lzeile & ")"
.Cells(lzeile + 4, 3).FormulaLocal = "=SUMMEWENN(B5:B" & lzeile & ";""Invest"";C5:C" & lzeile & ")"

.Cells(lzeile + 1, 4).FormulaLocal = "=SUMMEWENN(B5:B" & lzeile & ";""Anlaufkosten"";D5:D" & lzeile & ")"
.Cells(lzeile + 2, 4).FormulaLocal = "=SUMMEWENN(B5:B" & lzeile & ";""VOK"";D5:D" & lzeile & ")"
.Cells(lzeile + 3, 4).FormulaLocal = "=SUMMEWENN(B5:B" & lzeile & ";""BEMI"";D5:D" & lzeile & ")"
.Cells(lzeile + 4, 4).FormulaLocal = "=SUMMEWENN(B5:B" & lzeile & ";""Invest"";D5:D" & lzeile & ")"

.Cells(lzeile + 1, 5).FormulaLocal = "=SUMMEWENN(B5:B" & lzeile & ";""Anlaufkosten"";E5:E" & lzeile & ")"
.Cells(lzeile + 2, 5).FormulaLocal = "=SUMMEWENN(B5:B" & lzeile & ";""VOK"";E5:E" & lzeile & ")"
.Cells(lzeile + 3, 5).FormulaLocal = "=SUMMEWENN(B5:B" & lzeile & ";""BEMI"";E5:E" & lzeile & ")"
.Cells(lzeile + 4, 5).FormulaLocal = "=SUMMEWENN(B5:B" & lzeile & ";""Invest"";E5:E" & lzeile & ")"

.Cells(lzeile + 1, 6).FormulaLocal = "=SUMMEWENN(B5:B" & lzeile & ";""Anlaufkosten"";F5:F" & lzeile & ")"
.Cells(lzeile + 2, 6).FormulaLocal = "=SUMMEWENN(B5:B" & lzeile & ";""VOK"";F5:F" & lzeile & ")"
.Cells(lzeile + 3, 6).FormulaLocal = "=SUMMEWENN(B5:B" & lzeile & ";""BEMI"";F5:F" & lzeile & ")"
.Cells(lzeile + 4, 6).FormulaLocal = "=SUMMEWENN(B5:B" & lzeile & ";""Invest"";F5:F" & lzeile & ")"

.Cells(lzeile + 1, 7).FormulaLocal = "=SUMMEWENN(B5:B" & lzeile & ";""Anlaufkosten"";G5:G" & lzeile & ")"
.Cells(lzeile + 2, 7).FormulaLocal = "=SUMMEWENN(B5:B" & lzeile & ";""VOK"";G5:G" & lzeile & ")"
.Cells(lzeile + 3, 7).FormulaLocal = "=SUMMEWENN(B5:B" & lzeile & ";""BEMI"";G5:G" & lzeile & ")"
.Cells(lzeile + 4, 7).FormulaLocal = "=SUMMEWENN(B5:B" & lzeile & ";""Invest"";G5:G" & lzeile & ")"

.Cells(lzeile + 1, 8).FormulaLocal = "=SUMMEWENN(B5:B" & lzeile & ";""Anlaufkosten"";H5:H" & lzeile & ")"
.Cells(lzeile + 2, 8).FormulaLocal = "=SUMMEWENN(B5:B" & lzeile & ";""VOK"";H5:H" & lzeile & ")"
.Cells(lzeile + 3, 8).FormulaLocal = "=SUMMEWENN(B5:B" & lzeile & ";""BEMI"";H5:H" & lzeile & ")"
.Cells(lzeile + 4, 8).FormulaLocal = "=SUMMEWENN(B5:B" & lzeile & ";""Invest"";H5:H"

Answer 5

Hallo M.O.,

in der Testdatei hat das Makro nun auch bei mir funktioniert. In der Echten Datei hatte es aber nicht funktioniert. Habe den Fehler auch gefunden und bin ihm umgangen, allerdings kann ich mir die Ursache nicht so recht erklären:
Wenn in den Summen-Zeilen in Spalte B ein Wert bzw. Text steht, kommt der Fehler mit dem index... habe jetzt die Summenbeschreibung einfach in Spalte A geschrieben und somit Spalte B leer gelassen und es funktioniert einwandfrei.

Weisst du woran das liegen könnte?

Und nochmals vielen vielen Dank für deine Hilfe!!

LG peyd

Answer 6

Hallo Peyd,

für die Dimensionieriung des Feldes wird die letzte Zeile der Spalte B verwendet. Wenn nicht in der letzten Summenzeile in Spalte B ein Text steht, dann wird das Feld zu klein dimensioniert. Beim Einlesen wird ja in 4er-Schritten vorgegangen und dann passt die Dimensionierung nicht mehr.

Gruß

M.O.

Answer 7

Hallo M.O.,

stimmt, jetzt wo du es sagst ;-)

vielen Dank für deine Geduld, du hast mir sehr geholfen!!

LG peydd

Answer 8

Hallo nochmals ;)

kann man beim Löschen der Zelleninhalte den Bereich begrenzen? Wenn ich etwas hinter die Tabelle schrieben will, werden diese beim Ausführen des Makros mit gelöscht, da das Makro die kompletten Zeileninhalte löscht.

Hier der Befehl dazu:

'Nun Inhalt des Blattes Giesserei löschen
lzeile = Worksheets("Giesserei").Cells(Rows.Count, 2).End(xlUp).Row
With Worksheets("Giesserei")
.Range(.Cells(5, 1), .Cells(lzeile, 3)).EntireRow.Delete
End With

Danke schonmal :P
LG peydd

Answer 9

Hallo peyd,

ersetze die Zeilen (Löschen der ganzen Zeilen)

With Worksheets("Giesserei")
.Range(.Cells(5, 1), .Cells(lzeile, 3)).EntireRow.Delete
End With

durch (Löschen bis Spalte I)

With Worksheets("Giesserei")
.Range(.Cells(5, 1), .Cells(lzeile, 9)).MergeCells = False
.Range(.Cells(5, 1), .Cells(lzeile, 9)).ClearContents
End With

Gruß
M.O.

Answer 10

Hallo M.O.,

danke dür die schnelle Antwort, allerdings macht der Befehl nicht das war er sollte -.-
Wenn ich das Makro ausführe kopiert es die Zeilen bzw. den Bereich und fügt ihn darunter wieder ein. Die Daten, die hinter der tabelle stehen, werden aber nun nicht mehr gelöscht, verschieben sich aber wie gesagt nach unten.

LG peyd