Vermehren von Zeilen auf Basis eines Zellwertes

Forumthread: Vermehren von Zeilen auf Basis eines Zellwertes

23.05.2019 10:38:12

Zeilen

Hallo liebe Excelfreunde,
ich hoffe ich kann auf diesem Wege Hilfe bekommen. Ich habe ordentlich gesucht, aber keine hilfreichen Themen hier im Forum gefunden.
In Tabellenblatt 1 in der Spalte A1 bis A30 sind jeweils eine Artikelnummer eingetragen und in den anderen Spalten Daten dazu (das ist unwichtig). In einem anderen Tabellenblatt 2 sind auch wieder diese Artikelnummern eingetragen aber zusätzlich in Spalte B zwei jeweils eine Zahl (1-30). Beispieldatei ist angehängt.
Ich benötige eine Funktion, die in Tabellenblatt 2 die Artikelnummern nacheinander durchgeht. Sie nimmt die erste Artikelnummer, sucht diese in Tabellenblatt 1 und vermehrt die Zeile (kopieren und einfügen) genau so oft wie die zugehörtige Anzahl in Spalte B im Tabellenblatt 2. Danach wieder wie eben, aber mit dem zweiten Artikel in A2 aus dem Tabellenblatt 2.
https://www.herber.de/bbs/user/129980.xlsx
Ich hoffe ich konnte es verständlich erläutern und ihr könnt mir helfen.
Natürlich gerne einfach fragen, wenn etwas unklar ist.
Vielen herzlichen Dank im voraus!!
Gruß Thomas

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Vermehren von Zeilen auf Basis eines Zellwertes

23.05.2019 11:04:06

Zeilen

Hallo Thomas,
so:

Public Sub aaa()
Dim loLetzte As Long, i As Long, raFund As Range
Application.ScreenUpdating = False
With Worksheets("Tabelle2")
loLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = 1 To loLetzte
Set raFund = Worksheets("Tabelle1").Columns(1).Find(what:=.Cells(i, 1), LookIn:= _
xlValues, Lookat:=xlWhole)
If Not raFund Is Nothing Then
Worksheets("Tabelle1").Rows(raFund.Row).Copy
Worksheets("Tabelle1").Rows(raFund.Row + 1).Resize(.Cells(i, 2)).Insert
End If
Next i
End With
Application.CutCopyMode = False
End Sub

Gruß Werner

AW: Vermehren von Zeilen auf Basis eines Zellwertes

23.05.2019 11:11:26

Zeilen

Wahnsinn!
Das ist großartig. Danke Werner!
Hab noch einen schönen Tag.
Gruß Thomas
So, wo kann ich jetzt Werner die 5 Sterne Bewertung geben?

AW: Vermehren von Zeilen auf Basis eines Zellwertes

23.05.2019 11:15:45

Zeilen

Oh, ich habe noch eine kleine Frage. Wenn ich in Tabellenblatt 2 als Anzahl einmal die Null habe, dann geht es natürlich nicht. Das ist logisch. Dann bricht die Funktion ab. Ist es möglich dann einfach zu skippen?

AW: Vermehren von Zeilen auf Basis eines Zellwertes

23.05.2019 12:33:32

Zeilen

Hallo Thomas,
dann so:

Public Sub aaa()
Dim loLetzte As Long, i As Long, raFund As Range
Application.ScreenUpdating = False
With Worksheets("Tabelle2")
loLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = 1 To loLetzte
If .Cells(i, 2) > 0 Then
Set raFund = Worksheets("Tabelle1").Columns(1).Find(what:=.Cells(i, 1), _
LookIn:=xlValues, Lookat:=xlWhole)
If Not raFund Is Nothing Then
Worksheets("Tabelle1").Rows(raFund.Row).Copy
Worksheets("Tabelle1").Rows(raFund.Row + 1).Resize(.Cells(i, 2)).Insert
End If
End If
Next i
End With
Application.CutCopyMode = False
Set raFund = Nothing
End Sub

Gruß Werner

noch eine Änderung

23.05.2019 13:59:38

Werner

Hallo Thomas,
hier noch zusätzlich noch mit einer Prüfung ob es sich in Spalte B auch um eine Zahl handelt. Ansonsten würde das Makro in einen Fehler laufen, falls dort mal versehentlich ein Text rein gerutscht sein sollte.

Public Sub aaa()
Dim loLetzte As Long, i As Long, raFund As Range
Application.ScreenUpdating = False
With Worksheets("Tabelle2")
loLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = 1 To loLetzte
If IsNumeric(.Cells(i, 2)) And .Cells(i, 2) > 0 Then
Set raFund = Worksheets("Tabelle1").Columns(1).Find(what:=.Cells(i, 1), _
LookIn:=xlValues, Lookat:=xlWhole)
If Not raFund Is Nothing Then
Worksheets("Tabelle1").Rows(raFund.Row).Copy
Worksheets("Tabelle1").Rows(raFund.Row + 1).Resize(.Cells(i, 2)).Insert
End If
End If
Next i
End With
Application.CutCopyMode = False
Set raFund = Nothing
End Sub

Gruß Werner

AW: noch eine Änderung

23.05.2019 15:55:46

Thomas

Du bist klasse. 1000 Dank!
Das hilft mir wahnsinnig weiter.
Gruß Thomas

Gerne u. Danke für die Rückmeldung. o.w.T.

23.05.2019 16:10:28

Werner

Beliebteste Forumthreads (12 Monate)

Vermehren von Zeilen auf Basis eines Zellwertes

Forumthread: Vermehren von Zeilen auf Basis eines Zellwertes

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Vermehren von Zeilen auf Basis eines Zellwertes

Forumthread: Vermehren von Zeilen auf Basis eines Zellwertes

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread