Clever-Excel-Forum

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.[attachment=46567]

Verwende TextinSpalten

Hi,

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

VG Juvee

Hallo und vielen Dank,

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

Hast Du noch einen anderen Trick auf Lager?

LG

Andreas

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

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

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

Die Tabelle einmal duch PowerQuery jagen.

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

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

ari-2001

snb

juvee

ari-2001

Kuwer

snb

juvee

Cadmus

ari-2001