Text nach unten kopieren wenn in anderer zeile ein text steht

Question

Hallo Karin wäre es möglich, wenn ich in Spalte G etwas eintrage, erst dann soll diese Zahl oder Text solange nach unten kopiert werden solange in Spalte A etwas enthalten ist. Ich müsste das in den nachfolgenden makro einbauen. Vielen Dank im Voraus.

Sub nachJahrSortieren()

Application.ScreenUpdating = False 'Bildschirmaktualisierung ausschalten

    ActiveSheet.EnableOutlining = True 'für Gliederung

    ActiveSheet.EnableAutoFilter = True  'AutoFilter trotz Blattschutz

Sheets("Alle Teilnehmer").Activate

ActiveSheet.Range("A:n").Select     'ab Spalte G2 sortieren von Z bis A

Selection.Sort Key1:=Range("G2"), Key2:=Range("B2"), _

Order1:=xlDescending, Header:=xlYes, _

OrderCustom:=1, MatchCase:= _

False, Orientation:=xlTopToBottom

    Dim lngLetzte As Long       'Formel ab Spalte H2:I2 eintragen

    lngLetzte = IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows.Count)

    Cells(2, 8).Formula = "=IF(COUNTIF($I$2:I2,I2)=1,COUNTIF(I:I,I2),"""")"

    Cells(2, 9).Formula = "=IF(B2="""","""",B2&""  ""&C2&""  ""&E2)"

    Cells(2, 11).Formula = "=IF(AND(H2=1,G2=$L$1),""neu"","""")"

    Range("i2:H2").AutoFill Destination:=Range(Cells(2, 8), Cells(lngLetzte, 9)), Type:=xlFillDefault

    Range("k2").AutoFill Destination:=Range(Cells(2, 11), Cells(lngLetzte, 11)), Type:=xlFillDefault

        With Range("j2:J2")         ' Spalten und Rahmenfarbe ab Spalte J2 eintragen

        .HorizontalAlignment = xlCenter

        .Interior.Color = 13750737

        With .Borders(xlEdgeTop)

            .LineStyle = xlContinuous

            .Color = 11184814

            .Weight = xlThin

        End With

        .AutoFill Destination:=Range(Cells(2, 10), Cells(lngLetzte, 10)), Type:=xlFillFormats

    End With

Application.ScreenUpdating = True 'Bildschirmaktualisierung einschalten

    Range("G2").Select

End Sub

Answer 1

Dann poste doch mal deinen Code - vielleicht hat ja ein anderer User dasselbe Problem und kann ihn dann nutzen.

Ich würde es so lösen:

Sub Trennen()
    Dim lngZeile As Long
    For lngZeile = 3 To IIf(IsEmpty(Cells(Rows.Count, 3)), Cells(Rows.Count, 3).End(xlUp).Row, Rows.Count) Step 4
        Cells(lngZeile + 2, 3) = Split(Cells(lngZeile, 3), ": ")(1)
        Cells(lngZeile, 3) = Split(Cells(lngZeile, 3), ": ")(0) & ":"
    Next lngZeile
End Sub

Bis später, Karin

Answer 2

Hallo Karin, ich habe es so gemacht da ich es mit einem anderen code verbunden habe.

Sub Trennen()
    Dim lngZeile As Long
    For lngZeile = 3 To IIf(IsEmpty(Cells(Rows.Count, 3)), Cells(Rows.Count, 3).End(xlUp).Row, Rows.Count) Step 4
        Cells(lngZeile + 2, 3) = Split(Cells(lngZeile, 3), ":")(1)
        Cells(lngZeile, 3) = Split(Cells(lngZeile, 3), " :")(0) 
    Next lngZeile
End Sub

Answer 3

Hi Jelena,

das scheint mir aber nicht plausibel für den Teil vor dem ":"

Du trennst ja so " :" und das bedeutet, es soll an der Position eines Leerzeichen einschließlich eines nachfolgenden : getrennt werden - bei deinen Begriffen (so wie du sie gepostet hast) ist jedoch zwischen dem letzten Wort des 1. Teil und dem : gar kein Leerzeichen. Das Leerzeichen folgt erst nach dem : also muss es so heißen wie bei mir, nämlich ": "

Mit deinem Code trennst du zwar die Ziffer ab, jedoch bleibt in der Ausgangszelle der urprüngliche Begriff stehen. Dein Code bringt für das Beispiel Graun im Vinschgau: 0 folgendes Resultat

Graun im Vinschgau: 0

0

Mein Code dagegen bringt das von dir gewünchte Result, dass in der Ausgangszelle der Name einschließlich : übrig bleibt - also so

Graun im Vinschgau:

0

Bis später, Karin

Answer 4

Hallo Karin, ich hatte schon vorher einen code und um nicht den umzuschreiben habe ich diesen code so abgeändert. Trotzdem Danke

Answer 5

Hi Jelena,

keine Problem, wenn dein Code bei dir das richtige Ergebnis liefert, dann ist die Aufgabe für dich erfüllt - aber eben unter anderen Voraussetzungen als du weiter oben gepostet hast. Das richtige (von dir gewünschte) Ergebnis liefert er nur, wenn direkt anschließend an das letzte Wort ein Leerzeichen und erst dann der : folgt, und zwar in dieser Form Graun im Vinschgau : 0

Dies nur als Anmerkung für andere User, die diesen Thread ebenfalls lesen und sich wundern, dass sie ein anderes Ergebnis erhalten.

Bis später, Karin

Answer 6

Hallo Karin, habe meine Frage nicht richtig gestellt aber es passt. Danke

Answer 7

Hallo Karin, wenn ich den code

Sub Trennen()
    Dim lngZeile As Long
    For lngZeile = 3 To IIf(IsEmpty(Cells(Rows.Count, 3)), Cells(Rows.Count, 3).End(xlUp).Row, Rows.Count) Step 4
        Cells(lngZeile + 2, 3) = Split(Cells(lngZeile, 3), ":")(1)
        Cells(lngZeile, 3) = Split(Cells(lngZeile, 3), " :")(0) 
    Next lngZeile
End Sub
ein zweites mal ausführe bekomme ich eine fehlermeldung, wie kann das umgangen werden. Danke

Answer 8

Hi Jelena,

nach dem ersten Ausführen des Codes ist kein : mehr enthalten - folglich kann die Split-Funktion diese Bedingung für das Trennen des Zellinhaltes nicht mehr filden und löst logischerweise einen Fehler aus. Wenn du den Code mehrmals ausführen willst, musst du also vorher in einer If-Anweisung prüfen, ob überhaupt ein : enthalten ist

        If InStr(Cells(lngZeile, 3), ":") > 0 Then
            Cells(lngZeile + 2, 3) = Split(Cells(lngZeile, 3), ":")(1)
            Cells(lngZeile, 3) = Split(Cells(lngZeile, 3), " :")(0)
        End If

Bis später, Karin

Answer 9

Danke Karin für die Hilfe.