Abfrage, wenn Wert dann neue Zeilen

[Zeichner]

Hi zusammen

Ich probiere in VBA ein Code zu schrieben der 2 Abfragen macht: 

Hinter Welchem Bauteil sollen neue Zeilen eingefügt werden?
Wie viele Zeilen sollen eingefügt werden?

Danach sollte es nach den werten aus der ersten Abfrage suchen und so-viele Zeilen wie in der 2. Abfrage angegeben einfügen.

   

Also wenn ich in dem Beispiel das ich angehängt habe sollten die 2 Abfragen kommen, ich gebe z.b. zuerst Test und danach 3 ein, dann sollten hinter allen Zeilen mit dem Inhalt Test 3 Zeilen neu eingefügt werden.
Diese abfrage sollte in einer schleife sein und so oft durchgeführt werden bis ich abbreche.
Also Test, 4 / Ja, 3 / Nein, 2 usw.

In dem Beispiel das ich als Grundlage genommen habe wird nur die erste abfrage gemacht und direkt danach 1 Zeile eingefügt, die 2. Anfrage einzubauen schaffe ich leider nicht...

Ich hoffe jemand hier kann mir helfen.
Merci :)

Code:

Sub Leerezeile()
Dim lngI As Long
Dim Bauteil As String
Dim Zeilenanzahl As Integer
With ActiveSheet

'Abfrage:
Bauteil = InputBox("Hinter Welchem Bauteil sollen neue Zeilen eingefügt werden? Bitte Kürzel verwenden.")
Zeilenzahl = InputBox("Wie viele Zeilen sollen eingefügt werden?")

For lngI = .Range("A65536").End(xlUp).Row To 1 Step -1

If .Cells(lngI, 1).Value = Bauteil Then ' Schluesselwort: TotalIf .Cells(lngI, 1).Value = "Total" Then ' Schluesselwort: Total
.Rows(lngI + 1 & ":" & lngI + 1).Insert Shift:=xlUp
End If

Next lngI
End With


End Sub

[LuckyJoe]

Hi,

kannst du die Abfrage nach der Anzahl nicht mit in die erste Abfrage einbauen? Du gibst also z.B. ein "Test#3" (statt "#" kannst du auch ein anderes eindeutiges Trennzeichen nehmen).
In deinem Code trennst du die Eingabe dann zunächst auf und läßt dann weiterarbeiten.

[Zeichner]

Hi LuckyJoe

Vielen Danke für deine Antwort.

Kannst du mir ev. mit dem Code helfen? Da ich nicht viel Erfahrung im Programmieren klappt es leider nicht so recht..
Ich habe soeben auch festgestellt das nicht weitergesucht wird sobald eine Zeile leer steht, wie kann ich das beheben?

[LuckyJoe]

Hi,

probier mal Folgendes:

Code:

Sub Leerezeile()
    
    Dim i As Long
    Dim Anfrage As Variant
    Dim Bauteil As String
    Dim NeueZeilen As Integer
    Dim letzteZeile As Long
    
    Anfrage = InputBox("Bitte Bauteil und Anzahl neuer Zeilen eingeben, getrennt durch '#':")
    
    Anfrage = Split(Anfrage, "#")
    Bauteil = Anfrage(0)        ' 1. Teil vor dem '#'
    NeueZeilen = Anfrage(1)     ' 2. Teil nach dem '#'
    
    letzteZeile = ActiveSheet.Cells(Cells.Rows.Count, 1).End(xlUp).Row
    
    For i = letzteZeile To 1 Step -1
        If Cells(i, 1).Value = Bauteil Then
            With Rows(i + 1)
                .Resize(NeueZeilen).Insert Shift:=xlDown
            End With
        End If
    Next i

End Sub

[Zeichner]

Guten Morgen LuckyJoe

Vielen Dank für deine Hilfe.
Leider werden die neuen Zeilen nur nach dem ersten wert eingefügt, es sollte jedoch nach jedem wert, noch besser wäre es wenn ich in einer separaten abfrage noch eingeben könnte in Welchen Zeilen gesucht werden soll.

Verstehe ich das richtig das in dem Befehl: "letzteZeile = ActiveSheet.Cells(Cells.Rows.Count, 1).End(xlUp).Row"
definiert wird in welcher Zeile eingefügt wird? Ich habe leider nur sehr wenig Erfahrung in der Programmierung..

---

Hi LuckyJoe

Ich habe soeben meinen Code selber hinbekommen:

Code:

Sub Leerezeile()
   
   Dim i As Long
   Dim Anfrage As Variant
   Dim Anfrage2 As Variant
   Dim Bauteil As String
   Dim NeueZeilen As Integer
   Dim ErsteZeile As String
   Dim LetzteZeile As Long
   
   
   Anfrage = InputBox("Bitte Bauteil und Anzahl neuer Zeilen eingeben, getrennt durch '#':")
   Anfrage2 = InputBox("Bitte Von-Bis Zeile angeben, getrennt durch '#':")
   
   Anfrage = Split(Anfrage, "#")
   Bauteil = Anfrage(0)        ' 1. Teil vor dem '#'
   NeueZeilen = Anfrage(1)     ' 2. Teil nach dem '#'
   
   Anfrage2 = Split(Anfrage2, "#")
   ErsteZeile = Anfrage2(0)        ' 1. Teil vor dem '#'
   LetzteZeile = Anfrage2(1)     ' 2. Teil nach dem '#'
   
   For i = LetzteZeile To ErsteZeile Step -1
   
       If Cells(i, 3).Value = Bauteil Then 'Spalte C
           With Rows(i + 1)
               .Resize(NeueZeilen).Insert Shift:=xlDown
           End With
       End If
       
   Next i

End Sub

Vielen Lieben Dank für deine Hilfe, deine Grundlage war sehr Logisch das ich Ohne Probleme darin weiterarbeiten konnte :)

[LuckyJoe]

... aha, Spalte C ... ist ja nicht Spalte A wie in deinem Beispiel )

Prima, dass du weitergekommen bist. Du kannst auf die 2. Anfrage verzichten, wenn du vorher den Bereich selektierst und dann mit "With Selection" arbeitest.

Viel Erfolg!

[Zeichner]

Ja ist mir im nachhinein auch aufgefallen das ich das Falsche Beispiel drin hatte 

Super, danke für den tipp :D

[Zeichner]

Hi nocheinmal

Ich würde meinen Code gerne noch so ergänzen dass nicht leere Zeilen eingefügt werden sondern die obere Zeile kopiert wird,
Mein versuch kopiert die Zeile leider immer nur 1x, danach werden wie gehabt nur leere Zeilen eingefügt.
Unten die Bilder dazu..
Die erste spalte von dem 3.Screenshot ist rein informativ für das Beispiel und muss nicht ausgefüllt werden.

Ursprung:
   

Nach ausführung meines Codes
   

Ziel
   

Code:

Sub Leerezeile()
   
   Dim i As Long
   Dim Anfrage As Variant
   Dim Anfrage2 As Variant
   Dim Bauteil As String
   Dim Anzahl As Integer
   Dim ErsteZeile As String
   Dim LetzteZeile As String
   
   
   Anfrage = InputBox("Bitte Bauteil aus Spalte C und Anzahl neuer Zeilen eingeben, getrennt durch /:")
   Anfrage2 = InputBox("Bitte Von-Bis Zeile angeben, getrennt durch /:")
   
   Anfrage = Split(Anfrage, "/")
   Bauteil = Anfrage(0)        ' 1. Teil vor dem '#'
   Anzahl = Anfrage(1)     ' 2. Teil nach dem '#'
   
   Anfrage2 = Split(Anfrage2, "/")
   ErsteZeile = Anfrage2(0)        ' 1. Teil vor dem '#'
   LetzteZeile = Anfrage2(1)     ' 2. Teil nach dem '#'
   
   For i = LetzteZeile To ErsteZeile Step -1
   
       If Cells(i, 3).Value = Bauteil Then 'Wenn in Spalte C angegebenes Bauteil steht dann:
           With Rows(i + 1) 'Reihe / in nächster Zeile
               .Resize(Anzahl).Insert Shift:=xlDown 'Zeilen einfügen anzahl: "Neue Zeilen"
               Rows(i).Copy Rows(i + 1)
           End With
           
       End If
       
   Next i

End Sub

[LuckyJoe]

Hi,

ersetze mal die "For ... Next"-Schleife durch:

Code:

   For i = letzteZeile To 1 Step -1
       If Cells(i, 3).Value = Bauteil Then
           With Rows(i)
               .Copy
               .Resize(NeueZeilen).Insert Shift:=xlDown
           End With
       End If
   Next i

Viel Erfolg.

[Zeichner]

Kommt leider Laufzeitfehler '1004'...

Edit.
Hat Funktioniert :) Ich hatte einen währenddessen "NeueZeilen" in "Anzahl" umgeschrieben.

Vielen Herzlichen Dank :D