527 Aufrufe
Gefragt in Tabellenkalkulation von jelena Mitglied (737 Punkte)

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

29 Antworten

0 Punkte
Beantwortet von beverly_ Experte (3.3k Punkte)
Dann befindet sich eine leere Zelle oberhalb deiner Cursorposition - ich hatte ja bereits gesagt, dass es davon abhängt, wo sich der Cursor befindet wenn der Code läuft: es wird davon ausgegangen, dass sich der zu übertragende Wert 1 Zelle OBERHALB der Cursorposition befindet (s.a. Hinweis im Code).

Bis später, Karin
0 Punkte
Beantwortet von jelena Mitglied (737 Punkte)
Hallo Karin, wäre es möglich die erste leere Zelle in Spalte G suchen und die Zahl aus der letzten beschriebenen Zelle aus Spalte G nach unten kopieren (bis zum ende der eingabe aus Spalte A). Danke
0 Punkte
Beantwortet von beverly_ Experte (3.3k Punkte)
    Dim lngLetzte As Long
    Dim lngLetzteG As Long
    Dim lngZeile As Long
    Dim varWert As Variant
    lngLetzte = IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows.Count)
    lngLetzteG = IIf(IsEmpty(Cells(Rows.Count, 7)), Cells(Rows.Count, 7).End(xlUp).Row, Rows.Count)
    varWert = Cells(lngLetzteG, 7)
    For lngZeile = Cells(lngLetzteG + 1, 7) To lngLetzte
        If Cells(lngZeile, 1) <> "" Then Cells(lngZeile, 7) = varWert
    Next lngZeile

Falls es damit auch Probleme gibt, dann musst du mal deine Mappe hochladen, damit ich das selbst testen kann.

Bis später, Karin

0 Punkte
Beantwortet von jelena Mitglied (737 Punkte)
Bearbeitet von jelena

Hallo Karin, bei nachfolgender Datei soll in Spalte G die Zahl 2022 nach unten kopiert werden bis zum ende wo in Spalte A etwas eingetragen ist und dann erst der Rest des makros Sub nachJahrSortieren(). Danke

https://supportnet.de/forum/?qa=blob&qa_blobid=17262454326220324641

+1 Punkt
Beantwortet von beverly_ Experte (3.3k Punkte)

Hi Jelena,

mit einer hochgeladenen Mappe ist es auf jeden Fall immer einfacher, Probleme zu finden, weil verbale Beschreibungen nicht immer für Außenstehende eindeutig interpretierbar sind.

So sollte der Code jetzt funktionieren:

Sub nachJahrSortieren()
    Dim lngLetzte As Long
    Dim lngLetzteG As Long
    Application.ScreenUpdating = False 'Bildschirmaktualisierung ausschalten
    With Worksheets("Alle Teilnehmer")
        .EnableOutlining = True 'für Gliederung
        .EnableAutoFilter = True  'AutoFilter trotz Blattschutz
        lngLetzte = IIf(IsEmpty(.Cells(Rows.Count, 1)), .Cells(Rows.Count, 1).End(xlUp).Row, Rows.Count)
        lngLetzteG = IIf(IsEmpty(.Cells(Rows.Count, 7)), .Cells(Rows.Count, 7).End(xlUp).Row, Rows.Count)
        .Range(Cells(lngLetzteG + 1, 7), .Cells(lngLetzte, 7)) = .Cells(lngLetzteG, 7)
        .Range("A:n").Sort Key1:=.Range("G2"), Key2:=.Range("B2"), _
            Order1:=xlDescending, Header:=xlYes, _
            OrderCustom:=1, MatchCase:= _
            False, Orientation:=xlTopToBottom
        .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
        End With
        .Range("J2").AutoFill Destination:=.Range(.Cells(2, 10), .Cells(lngLetzte, 10)), Type:=xlFillFormats
    End With
    Application.ScreenUpdating = True 'Bildschirmaktualisierung einschalten
End Sub

Bis später, Karin

+1 Punkt
Beantwortet von
Hallo Karin, soweit ich es probiert habe läuft es perfekt. Besten Dank
0 Punkte
Beantwortet von jelena Mitglied (737 Punkte)
Hallo Karin, muss leider schon wieder stören. Ich habe eine Excel Datei da steht in Zelle C3 Meran: 248 und in Zelle C7 Aldein: 2 nun soll in Zelle C3 der Text Meran: und in Zelle C5 die Zahl 248 stehen, dann soll in Zelle C7 der Text Aldein: und in der Zelle C9 die Zahl 2 stehen. Die Zellen C4, C6, C8, C10 usw. sind leer. Die letzte Zahl ist in Zelle C465. Bitte um Hilfe, Danke
+1 Punkt
Beantwortet von beverly_ Experte (3.3k Punkte)

Hi Jelena,

das sollte man wie folgt lösen können:

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

0 Punkte
Beantwortet von jelena Mitglied (737 Punkte)
Hallo Karin soweit passt es, habe aber nicht mit einem längeren namen gerechnet zB. Graun im Vinschgau: 0 oder Kastelbell-Tschars: 2 oder Unsere Liebe Frau im Walde-St. Felix: 3 es soll nach dem doppelpunkt geteilt werden, vieleicht ist das auch noch machbar. Danke
0 Punkte
Beantwortet von jelena Mitglied (737 Punkte)
Danke Karin ich hab's selbst geschafft.
...