Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1892to1896
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Zeile kopieren wenn Inhalt ";" enthält

Zeile kopieren wenn Inhalt ";" enthält
21.07.2022 10:53:05
FinLu
Guten Morgen,
folgende Problemstellung.
Ich habe eine Excel Tabelle mit einer Auflistung von Rohstoffen. Diesen Rohstoffen ist in Spalte D eine Kennziffer zugeordnet ODER mehr als eine Kennziffer, getrennt durch ein Semikolon.
Gerne hätte ich die Möglichkeit per Makro etc. die ganze Tabelle automatisiert überarbeiten zu lassen.
Wenn in Spalte D mehr als eine Kennziffer vorhanden ist (getrennt durch Semikolon) dann soll diese ganze Zeile darunter kopiert werden.
Ideal wäre es natürlich wenn hinterher pro Zeile dann nur noch EINE Kennziffer in Spalte D steht.
Userbild
Userbild

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zeile kopieren wenn Inhalt ";" enthält
21.07.2022 12:23:10
MCO
Hallo FinLu!
Das sollte machen was es soll:

Sub Dat_satz_duplizieren()
For Each num In Range("D:D").SpecialCells(xlCellTypeConstants) 'alle gefüllten Zellen in "D"
If InStr(num, ";") > 0 Then 'prüfen
neu_zeil = Range("A" & Rows.Count).End(xlUp).Row + 1 'freie Zeile ermitteln
Range("A" & num.Row & ":C" & num.Row).Copy Range("A" & neu_zeil) 'A-C kopieren
Range("D" & neu_zeil) = Trim(Split(Range("D" & num.Row), ";")(1)) 'D mit zweitem Teil füllen
Range("D" & num.Row) = Trim(Split(Range("D" & num.Row), ";")(0)) 'Alt_D mit erstem Teil füllen
End If
Next num
End Sub
Gruß, MCO
Anzeige
AW: Zeile kopieren wenn Inhalt ";" enthält
21.07.2022 12:53:30
Markus
Hallo MCO,
vielen Dank für die prompte Rückmeldung.
Das hat SUPER funktioniert ! Ich bin begeistert :)
Viele Grüße,
Markus
AW: Zeile kopieren wenn Inhalt ";" enthält
21.07.2022 14:44:27
PawelPopolski
Kurz und knackig! Ich hab's mal getestet. Macht Probleme, wenn mehr als 2 Nummern in der Zelle stehen. Das sollte funktionieren, wenn x Kennziffern in Zelle

Sub KennziffernVereinzeln()
Dim ws As Worksheet
Set ws = ActiveWorkbook.Worksheets("Rohstoffe")
With ws
Do
Dim zeile As Variant
zeile = Application.Match("*;*", .Range("D:D"), 0)
If IsError(zeile) Then Exit Do
Dim arr() As String
arr = Split(.Range("D" & zeile), ";")
.Cells(zeile, 4) = Trim(arr(0))
Dim rng As Range
Set rng = .Range(.Cells(zeile, 1), .Cells(zeile, 3))
Dim lRow As Long
Dim i As Integer
For i = LBound(arr) + 1 To UBound(arr)
lRow = .Range("A1").CurrentRegion.Rows.Count + 1
rng.Copy .Cells(lRow, 1)
.Cells(lRow, 4) = Trim(arr(i))
Next i
Loop
End With
End Sub

Anzeige

306 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige