Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1520to1524
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

Zeilenumbruch erzeugt neue Zeile

Zeilenumbruch erzeugt neue Zeile
25.10.2016 13:21:24
Toastie
Hallo zusammen,
als fast Ahnungsloser in Sachen VBA brauche ich eure Hilfe. Ich habe folgende Problemstellung:
In einem Tabellenblatt t1 befindet sich eine Tabelle. Diese soll zeilenweise in ein neues Tabellenblatt t2 kopiert werden. Dabei soll jedoch für jeden Zeilenumbruch in der 6. Spalte in t1 eine eigene Zeile in t2 erzeugt werden. Die Inhalte der anderen Spalten der neuen Zeile in t1 sind identisch außer natürlich die 6. Spalte. Die soll jeweils nur einen Wert haben.
Ich füge eine Beispieldatei mit t1 und t2 an wie das Endergebnis aussehen soll.
https://www.herber.de/bbs/user/109008.xlsx
Besten Dank!
Grüße
Toastie

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zeilenumbruch erzeugt neue Zeile
25.10.2016 14:07:09
Daniel
Hi
eine mögliche Markolösung:
Sub umformen()
Dim shQ As Worksheet
Dim shZ As Worksheet
Dim Zeile As Range
Dim ZelleZiel As Range
Dim TeilTexte
Set shQ = Sheets("Grunddaten - t1")
Set shZ = Sheets("Aufbereitet - t2")
shZ.Cells.Clear
For Each Zeile In shQ.UsedRange.Rows
TeilTexte = Split(Zeile.Cells(1, 6).Value, vbLf)
Set ZelleZiel = shZ.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
Zeile.EntireRow.Copy
ZelleZiel.Resize(UBound(TeilTexte) + 1, 1).EntireRow.PasteSpecial xlPasteAll
ZelleZiel.Offset(0, 6 - 1).Resize(UBound(TeilTexte) + 1).Value = _
WorksheetFunction.Transpose(TeilTexte)
Next
shZ.Rows(1).Delete
End Sub
gruß Daniel
Anzeige
AW: Zeilenumbruch erzeugt neue Zeile
25.10.2016 14:19:47
UweD
Hallo
Daniel war zwar schneller..
Aber hier ein Lösung von mir
Sub fgfgdg()
    On Error GoTo Fehler
    Dim i%, Arr, Anz%
    Dim SP%, ZE&, LR&
    
    Application.ScreenUpdating = False
    SP = 6 'Spalte F 
    ZE = 2 'ab Zeile 
    
    LR = Cells(Rows.Count, SP).End(xlUp).Row 'letzte Zeile der Spalte 
    For i = LR To ZE Step -1
        Arr = Split(Cells(i, SP), vbLf)
        Anz = Ubound(Arr)
        Rows(i + 1 & ":" & i + Anz).Insert
        Rows(i).Copy Rows(i + 1 & ":" & i + Anz)
        Range(Cells(i, SP), Cells(i + Anz, SP)) = WorksheetFunction.Transpose(Arr)
    Next i
    Err.Clear
    On Error GoTo Fehler
Fehler:
    If Err.Number <> 0 Then MsgBox "Fehler: " & _
        Err.Number & vbLf & Err.Description: Err.Clear
End Sub
LG UweD
Anzeige
AW: Zeilenumbruch erzeugt neue Zeile
25.10.2016 14:39:36
UweD
bab nicht weit genug getestet.
Sub fgfgdgewew()
    On Error GoTo Fehler
    Dim i%, Arr, Anz%
    Dim SP%, ZE&, LR&
    
    Application.ScreenUpdating = False
    SP = 6 'Spalte F 
    ZE = 2 'ab Zeile 
    
    LR = Cells(Rows.Count, SP).End(xlUp).Row 'letzte Zeile der Spalte 
    For i = LR To ZE Step -1
        Arr = Split(Cells(i, SP), vbLf)
        Anz = Ubound(Arr)
        If Anz > 0 Then
            Rows(i + 1).Resize(Anz).Insert
            Rows(i).Copy Rows(i + 1).Resize(Anz)
            Cells(i, SP).Resize(Anz + 1) = WorksheetFunction.Transpose(Arr)
        End If
    Next i
    Err.Clear
    On Error GoTo Fehler
Fehler:
    If Err.Number <> 0 Then MsgBox "Fehler: " & _
        Err.Number & vbLf & Err.Description: Err.Clear
End Sub
LG UweD
Anzeige
AW: Zeilenumbruch erzeugt neue Zeile
25.10.2016 21:46:10
Toastie
Klappt super, vielen DANK!!!
Im nächsten Schritt muss ich eine zusätzliche Aufbereitung durchführen. Diesmal habe ich als Trennzeichen kein Zeilenumbruch sondern ein Semikolon. Erschwerend kommt hinzu, dass sich die Trennzeichen in zwei Spalten befinden (1:1 Beziehung). D.h. der Inhalt in zwei Zellen muss gleichzeitig gesetzt/gekürzt werden. Anbei wieder eine Beispieldatei.
https://www.herber.de/bbs/user/109018.xlsx

299 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige