Zeilen, die Komma enthalten, kopieren und Werte aufteilen

[ari-2001]

Hallo liebe Gemeinde,

ich versuche grade, dass das Makro in einer Spalte ein "," findet, diese Zeile dann verdoppelt und den Wert, der in der Spalte steht, auf die beiden
Zeilen in der Nachbarzeile darzustellen.

Das heißt, dass der erste Wert, der vor dem Komma steht, in die Nachbarzelle der Ursprungszeile geschrieben wird und der Wert, der nach dem Komma steht,
in die Nachbarzelle der verdoppelten Zeile (jeweils neben der Spalte "Dienste"), so dass ich für beide Dienste jeweils eine Zeile habe.

Dass verdoppeln klappt wunderbar, nur das aufsplitten des Wertes bekommen ich nicht hin.

Hier mein Versuch:

Dim LR As Long, i As Long, Dienste As String, Dienst1 As String, Dienst2 As String
    Application.ScreenUpdating = False
    With Sheets("Testblatt")
        If .FilterMode Then .ShowAllData ' Autofilter alle
        LR = .Cells(.Rows.Count, "A").End(xlUp).Row 'letzte Zeile der Spalte
        For i = LR To 2 Step -1
            If InStr(.Cells(i, 14), ",") > 0 Then
            With .Range(.Cells(i, 1), .Cells(i, 14))
                    .Offset(1, 0).Insert Shift:=xlDown
                    .Copy .Offset(1, 0)
                   
                    Dienste = .Cells(i, 14).Value 'Wert der Zelle "Dienste"
                    Dienst1 = Left(Dienste, 4) ' Dienst1
                    Dienst2 = Right(Dienste, 4) ' Dienst2
                  .Cells(i, 15) = Dienst1
                  .Cells(i + 1, 15) = Dienst2
                End With
            End If
        Next
    End With


Wo ist mein Denkfehler bei der ganzen Sache?

Viele Grüße
Andreas

Testdatei ist dabei.
  Testmappe CEF.xlsm (Größe: 22,43 KB / Downloads: 9)

[snb]

Verwende TextinSpalten

[juvee]

Hi,

schließe das 2. With ... nach dem Kopieren der Zeile

VG Juvee

[ari-2001]

Hallo und vielen Dank,

leider führt das nicht zum gewünschten Erfolg.

Hast Du noch einen anderen Trick auf Lager?

LG

Andreas

[Kuwer]

Hallo,

Code:

Sub DiensteSplitten()
  Dim LR As Long, i As Long
  Application.ScreenUpdating = False
  With Sheets("Testblatt")
    If .FilterMode Then .ShowAllData ' Autofilter alle
    LR = .Cells(.Rows.Count, 1).End(xlUp).Row 'letzte Zeile der Spalte
    For i = LR To 2 Step -1
      If InStr(.Cells(i, 14), ",") > 0 Then
        .Rows(i).Copy
        .Rows(i + 1).Insert
        .Cells(i, 15).Resize(2).Value = Application.Transpose(Split(.Cells(i, 14).Value, ","))
      End If
    Next
  End With
  Application.CutCopyMode = False
End Sub

Gruß Uwe

[snb]

Code:

Sub M_snb()
  sn = Cells(1).CurrentRegion
 
  For j = 2 To UBound(sn)
    st = Split(sn(j, 14), ", ")
    If UBound(st) > 0 Then
        sn(j, 14) = st(1)
        Cells(2000 + j, 1).Resize(, 14) = Application.Index(sn, j)
        sn(j, 14) = st(0)
    End If
  Next
 
  Cells(1).CurrentRegion = sn
  Columns(1).SpecialCells(4).EntireRow.Delete
End Sub

[juvee]

Hi,

jo, du mußt natürlich den Bereich auch auf 15 Spalten erweitern

Code:

Sub DiensteSplitten()
Dim LR As Long, i As Long, Dienste As String, Dienst1 As String, Dienst2 As String
    Application.ScreenUpdating = False
    With Sheets("Testblatt")
        If .FilterMode Then .ShowAllData ' Autofilter alle
        LR = .Cells(.Rows.Count, "A").End(xlUp).Row 'letzte Zeile der Spalte
        For i = LR To 2 Step -1
            If InStr(.Cells(i, 14), ",") > 0 Then
            With .Range(.Cells(i, 1), .Cells(i, 15))  'hier
                    .Offset(1, 0).Insert Shift:=xlDown
                    .Copy .Offset(1, 0)
              End With                                 'hier
                    Dienste = .Cells(i, 14).Value 'Wert der Zelle "Dienste"
                    Dienst1 = Left(Dienste, 4) ' Dienst1
                    Dienst2 = Right(Dienste, 4) ' Dienst2
                  .Cells(i, 15) = Dienst1
                  .Cells(i + 1, 15) = Dienst2
               
            End If
        Next
    End With
End Sub

VG Juvee

[Cadmus]

Die Tabelle einmal duch PowerQuery jagen.

Spalten Dienste aufteilen. Unter "erweitert" -> Zeilen auswählen.

[ari-2001]

Hallo zusammen,

habt vielen Dank, ich hätte es mit Sicherheit nicht hinbekommen!

Tolle, schnell arbeitende Lösungsvorschläge.

Noch einmal herzlichen Dank in die Runde!

Gruß
Andreas