Excel VBA: bei bestimmten Wert in anderem Tabellenblatt zeilen einfügen mit inhalt und Formel

Question

Hallo zusammen,
ich habe folgende Herausforderung:
Wenn im Tabellenblatt „Verkaufsgruppen“ in der Spalte D3:D215 ein „Ja“ vorkommt, soll im Tabellenblatt “Giesserei“ jeweils Ab Zeile4 ; 3 neue Zeilen eingefügt werden. Die 1. Zeile soll in der Spalte B den Inhalt “ VOK“ bekommen, die 2. Zeile „BEMI“ und die 3. Zeile “Invest“. In Spalte A sollen die 3 Zeilen verbunden und zentriert werden. Des Weiteren soll in dieser Spalte A jeweils der Name der Verkaufsgruppe, welche im Tabellenblatt “Verkaufsgruppen“ in der Spalte B steht, übernommen werden.
In der Zeile 5;6;7 sollen die Summen der Werte, welche man manuell in die Spalte C der neuen Zeilen einträgt, gebildet werden. Die neuen Zeilen müssen also in eine Summenformel integriert werden.

Bin VBA Neuling und Habe leider nicht die Zeit mir alle Grundkenntnisse anzueignen, da mein Chef das so schnell wie möglich haben möchte. Habe auch nach stundenlangen googlen kein vergleichbares Makro gefunden. Habe versucht einiges über den Makro-aufzeichner zu lösen aber leider ohne Erfolg, da dies zu statisch ist.
Hier mein Ansatz: (wobei dieser wie gesagt viel zu statisch und nicht vollständig ist)

Option Explicit
Option Compare Text
Sub Makro3()

Const strSearchText = "Ja"
Dim rSearch As Range, c As Range
Dim wsSrc As Worksheet
Set wsSrc = Sheets("Verkaufsgruppen")
Set rSearch = wsSrc.Range("D3:D215")
For Each c In rSearch
If c.Value = strSearchText Then

Sheets("Giesserei").Select
Rows("4:4").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("B5").Select
ActiveCell.FormulaR1C1 = "VOK"
Range("B6").Select
ActiveCell.FormulaR1C1 = "BEMI"
Range("B7").Select
ActiveCell.FormulaR1C1 = "Invest"

Range("A5:A7").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge

Range("C8").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-3]C)"
Range("C9").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-3]C)"
Range("C10").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-3]C)"

End If
Next c
End Sub

Ich hoffe ihr könnt mir helfen (wenn das überhaupt machbar ist -.-)
Mit freundlichen Grüßen
peyd

Answer 1

Hallo Peyd,

versuch es mal mit folgendem Makro:

Sub zeilen_einfuegen()

Dim rCell As Range
Dim rRng As Range

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

End With

End If

Next rCell

End Sub

Wie du sehen wirst, fügt das Makro allerding (noch) keine Summe ein. Erkläre doch mal bitte etwas genauer, wie die Summe gebildet werden soll, d.h. welche Zellen sie umfassen soll etc.

Probiere das Makro aber erst einmal in einer Testdatei aus.

Gruß

M.O.

Answer 2

Hallo M.O.,

vielen Dank für die super schnelle Antwort!
Das Makro funktioniert einwandfrei! Danke schonmal dafür - ist wesentlich eleganter gelöst!

Bevor wir aber über die Summe sprechen hätt ich noch ein kleines Anliegen:

In die formatierte Spalte A soll noch die Zelleninhalte aus dem Tabellenblatt "Verkaufsgruppen" aus der Spalte B übernommen werden. Also das Tabellenblatt "Verkaufsgruppen" ist so aufgebaut: in Spalte B3:B215 Stehen Namen und ich spalte D3:D215 dann jeweils "Ja" oder "Nein", wenn ich also in Spalte D ein "ja" eintrage soll der dazugehörige Name aus der Spalte B in die formatierte Zelle (Spalte A) im Tabellenblatt "Giesserei" eingefügt werden.

gibt's dafür eine geeignete Lösung?
Hoffe habe es verständlich beschrieben.

Mfg peyd

Answer 3

Hi all,

zunächst mal ein Lob an M.O. für den guten Makroaufbau.

Mein Tipp zu Spalte A:
füge nach .MergeCells = True folgende Zeile ein:

.value = rcell.Offset(0, -2)

Mr. K.

Answer 4

Hallo,

meinst du das etwa so:

Sub zeilen_einfuegen()

Dim rCell As Range
Dim rRng As Range

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

End Sub

Gruß

M.O.

Answer 5

beide Lösungen funktionieren einwandfrei! Ihr seid die Besten! :P

zu den Summen:

Es sollen quasi die Summen der einzelnen Zeilen von "VOK" ; "BEMI" ; "Invest" , die neu eingefügt wurden, gebildet werden. D.h. unter den neu eingefügten Zeilen befinden sich 3 Zeilen(welche sich aber nach unten verschieben, wenn die neuen Zeilen eingefügt werden):
1. Zeile (Blattzeile 5, Spalte B): Summe VOK
2. Zeile (Blattzeile 6, Spalte B): Summe BEMI
3. Zeile (Blattzeile 7, Spalte B): Summe Invest

in der Blattzeile 5, Spalte C sollen dann alle Werte der neu eingefügten zeilen "VOK" addiert werden, welche ich manuell in die neu eingefügten Zeilen in der Spalte C eintrage.
Also: erster VOK Wert wird in Blattzeile 4, Spalte C eingetragen, der nächste VOK Wert dann 3 Zeilen weiter unten usw.
Das Selbe dann auch für "BEMI" und "Invest"

Das Problem hierbei ist das man die Summen von Zellen bilden muss die vorher noch nicht da sind und sich die Zelle in der die Summen stehen sollen nach unten verschieben. Ist sowas überhaupt realisierbar?

ich hoffe es ist einigermaßen verständlich. (ohne Bilder echt schwer zu erklären -.-)

LG peyd

Answer 6

Hallo,

@ Peyd:

Schau mal, ob das so passt:

Sub zeilen_einfuegen()

Dim rCell As Range
Dim rRng As Range

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 der Formel werden Summewenn-Formeln am Ende des Arbeitsblatts eingefügt.

@Excelking
Ich habe deine Antwort zwar gelesen, aber irgendwie nicht richtig registriert :-(. Deine Lösung ist ja etwas kürzer.

Gruß

M.O.

Answer 7

Hallo,

noch ein Nachtrag:

natürlich sollte auch die Variable lzeile noch ordnungsgemäß dimensioniert werden.

Am Anfang des Makros sollte also stehen:

Dim rCell As Range
Dim rRng As Range
Dim lzeile As Long

Gruß

M.O.

Answer 8

Hallo,

das Makro hat auf Anhieb funktioniert!!! Du bist ein Genie ;-)
vielen vielen Dank, das hat mit sehr viel Arbeit erspart und schlauer bin ich auch geworden!

Tolles Forum!

Bis zum nächsten mal :P

Mfg
peyd