Hallo Community,
ich habe ein Problem mit einer Excel Liste, welches ich mit VBA beheben möchte. Es geht darum, dass Zeilen, indem der Faktor "2" steht, kopiert werden sollen und genau darunter eingefügt werden sollen. Bei Zeilen mit dem Faktor "3", soll die Zeile kopiert werden und 2x drunter eingefügt werden. So z.B.:
222222
222222
33333333
33333333
33333333
44444444
44444444
44444444
44444444
Bisher habe ich es nur geschafft, unter der Zeile indem eine "2" steht, eine leere Zeile hinzuzufügen.
Code:
Dim u As Integer
For u = 30000 To 1 Step -1
If Cells(u, "L").Value = "2" Then
Cells(u + 1, "L").EntireRow.Insert
End If
Next u
Wie kann ich die ganze Zeile kopieren und drunter einfügen ? Bzw. bei anderen Werten mehrere Zeilen einfügen ?
Wäre für Hilfe sehr dankbar.
Viele Grüße
MiBi
Hallo MiBi,
mein (getesteter) Vorschlag:
Sub aaa()
Dim lngZ As Long
Dim strE As String
For lngZ = 30000 To 1 Step -1
strE = Left(Cells(lngZ, "L").Value, 1)
If IsNumeric(strE) Then
Rows(lngZ).Copy
Rows(lngZ + 1).Resize(CLng(strE) - 1).Insert
End If
Next lngZ
Application.CutCopyMode = False
End Sub
Gruß Uwe
(07.09.2020, 10:07)Lutz Fricke schrieb: [ -> ]Hallo MiBi,
versuch doch mal das:
Code:
For u = 30000 To 1 Step -1
If Cells(u, "L").Value >= 2 Then
For Zaehler = 1 To Cells(u, "L").Value - 1
Cells(u, "L").EntireRow.Copy
Cells(u + 1, "L").Insert Shift:=xlDown
Next Zaehler
End If
Next u
Ist ungestestet.
Gruß,
Lutz
Hallo Lutz,
vielen Dank für die Antwort. Leider funktioniert es damit nicht. Die Zeile mit x1Down passt laut VB nicht.
(07.09.2020, 10:10)Kuwer schrieb: [ -> ]Hallo MiBi,
mein (getesteter) Vorschlag:Sub aaa()
Dim lngZ As Long
Dim strE As String
For lngZ = 30000 To 1 Step -1
strE = Left(Cells(lngZ, "L").Value, 1)
If IsNumeric(strE) Then
Rows(lngZ).Copy
Rows(lngZ + 1).Resize(CLng(strE) - 1).Insert
End If
Next lngZ
Application.CutCopyMode = False
End Sub
Gruß Uwe
Hallo Uwe,
danke für die Hilfe. Auch hier klappt es leider irgendwie bei mir nicht.
Die Zeile:
Rows(lngZ + 1).Resize(CLng(strE) - 1).Insert macht bei mir einen Fehler.
Hallo,
vermutlich sind verbundene Zellen im Spiel, wenn diese Fehlermeldung kommt.
Gruß Uwe
(07.09.2020, 10:33)Kuwer schrieb: [ -> ]Hallo,
vermutlich sind verbundene Zellen im Spiel, wenn diese Fehlermeldung kommt.
Gruß Uwe
Hallo Uwe,
es ist eine Tabelle mit knapp 30000 Zeilen, wo in Spalte L entweder eine 1,2,3 oder 4 ist. Ich habe deinen Code mal woanders benutzt, leider klappt er da auch nicht. Ist es nicht einfach möglich, dass er bei meinem Code die Zeile kopiert und drunter einfügt, statt drunter eine leere Zeile zu erstellen ?
Code:
Dim u As Integer
For u = 30000 To 1 Step -1
If Cells(u, "L").Value = "2" Then
Cells(u + 1, "L").EntireRow.Insert
End If
Next u
Das hier klappt gut, jedoch kopiert er nicht die Zeile sondern fügt eine leere drunter ein. Mit "Copy" komm ich grad nicht zu recht.
(07.09.2020, 10:40)MiBi schrieb: [ -> ]Ich habe deinen Code mal woanders benutzt, leider klappt er da auch nicht.
Nun auch mit Einsern:
Sub aaa()
Dim lngZ As Long
Dim strE As String
For lngZ = 30000 To 1 Step -1
strE = Left(Cells(lngZ, "L").Value, 1)
If IsNumeric(strE) Then
If CLng(strE) > 1 Then
Rows(lngZ).Copy
Rows(lngZ + 1).Resize(CLng(strE) - 1).Insert
End If
End If
Next lngZ
Application.CutCopyMode = False
End Sub
Gruß Uwe
(07.09.2020, 10:51)Kuwer schrieb: [ -> ]Nun auch mit Einsern:Sub aaa()
Dim lngZ As Long
Dim strE As String
For lngZ = 30000 To 1 Step -1
strE = Left(Cells(lngZ, "L").Value, 1)
If IsNumeric(strE) Then
If CLng(strE) > 1 Then
Rows(lngZ).Copy
Rows(lngZ + 1).Resize(CLng(strE) - 1).Insert
End If
End If
Next lngZ
Application.CutCopyMode = False
End Sub
Gruß Uwe
Danke Uwe :)
Klappt jetzt alles. Vielen vielen Dank
Ich konnte die VBA-Lösung perfekt für mich einsetzen
Und es hat mir unglaublich viel Arbeit erspart - herzlichen Dank dafür!
Einzig hätte ich den Unterschied, dass nicht die Inhalte der ganzen Zeilen kopiert werden sollen, sondern nur die Inhalte der ersten zwei Spalten.
Da auch ich VBA-technisch nicht wirklich fit bin, wäre ich für einen Tipp sehr dankbar.
Vielen Dank für jeden Tipp und ebensolche Grüße
VBA4Beginner