Ausfuellen bis nächsten Wert_unten nach oben

Sub Ausfüllen() Dim w As Variant Dim c As Range Application.ScreenUpdating = False For Each c In Selection If c.Value "" Then w = c.Value Else c.Value = w c.Font.ColorIndex = 37 '19 waere hellgelb c.Font.Bold = False End If Next c Application.ScreenUpdating = True End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Andreas,
ich geh davon aus, das deine Markierung eine zusammenhängende ist, dann zB. so:

Sub VonUntenNachOben()
    Dim lngStartRow As Long, lngEndeRow As Long
    Dim lngZeile As Long, intSpalte
    Dim intStartSpalte As Integer, intEndeSpalte As Integer
    Dim w
    'Wenn die Selection nur aus einer Spalte besteht, reicht dies:
    lngStartRow = Selection.Row + Selection.Rows.Count - 1
    lngEndeRow = Selection.Row
    For lngZeile = lngStartRow To lngEndeRow Step -1
        If Cells(lngZeile, Selection.Column).Value <> "" Then
           w = Cells(lngZeile, Selection.Column).Value
        Else
           Cells(lngZeile, Selection.Column).Value = w
           Cells(lngZeile, Selection.Column).Font.ColorIndex = 37
           Cells(lngZeile, Selection.Column).Font.Bold = False
        End If
    Next lngZeile
    'Wenn Selection aus mehreren Spalten besteht, so
    lngStartRow = Selection.Row + Selection.Rows.Count - 1
    lngEndeRow = Selection.Row
    intStartSpalte = Selection.Column
    intEndeSpalte = Selection.Column + Selection.Columns.Count - 1
    For intSpalte = intStartSpalte To intEndeSpalte
        For lngZeile = lngStartRow To lngEndeRow Step -1
            If Cells(lngZeile, intSpalte).Value <> "" Then
               w = Cells(lngZeile, intSpalte).Value
            Else
               Cells(lngZeile, intSpalte).Value = w
               Cells(lngZeile, intSpalte).Font.ColorIndex = 3
               Cells(lngZeile, intSpalte).Font.Bold = False
            End If
        Next lngZeile
     Next intSpalte
End Sub

Gruß Worti

Hallo Worti,
vielen Dank für Deinen Code. Der ist genial und läuft. Er kam auch genau zur rechten Zeit, denn heute habe ich viele Makro Ideen mit Hilfe von VBA Editor Hilfe und Forum umsetzen können. Es ist ein tolles Gefühl, so etwas Schritt für Schritt dann allein entwickeln zu können. Und was man dabei lernt!!! Wahnsinn!
Zu sehen, daß Dein Makro läuft ist der krönende Abschluß dieses Tages. Deine Mehrspaltige Lösung geisterte mir auch schon im Kopf rum und nun lieferst Du sie gleich mit ;-)
Ich habe mir erlaubt, es so zu verändern, daß es nun auch Oben nach Unten Mehrspaltig läuft und -bin als VBA Anfänger ein bißchen stolz drauf... - eine Codezeile eingefügt, die die selection automatisch (bis zum Ende der Tabelle) entsprechend der markierten ersten Zellen setzt.
Vielleicht kannst Du den Ansatz gebrauchen oder aber jemand anderes im Forum. Denn dann hat es seinen Zweck erfüllt.


Sub Ausfüllen_VonObenNachUnten_automatischeSelection_Mehrspaltig()
Dim lngStartRow As Long, lngEndeRow As Long
Dim lngZeile As Long, intSpalte
Dim intStartSpalte As Integer, intEndeSpalte As Integer
Dim w
Range(Selection, Cells(Range(Selection.Address).SpecialCells(xlCellTypeLastCell).Row, Selection. _
Column)).Select      'mit dieser Zeile werden für alle markierten Spalten die Zellen bis jeweils zum Ende der Tabelle markiert
lngStartRow = Selection.Row
lngEndeRow = Selection.Row + Selection.Rows.Count - 1
intStartSpalte = Selection.Column
intEndeSpalte = Selection.Column + Selection.Columns.Count - 1
For intSpalte = intStartSpalte To intEndeSpalte
For lngZeile = lngStartRow To lngEndeRow Step 1
If Cells(lngZeile, intSpalte).Value  "" Then
w = Cells(lngZeile, intSpalte).Value
Else
Cells(lngZeile, intSpalte).Value = w
Cells(lngZeile, intSpalte).Font.ColorIndex = 3
Cells(lngZeile, intSpalte).Font.Bold = False
End If
Next lngZeile
Next intSpalte
End Sub

Mit den besten Grüßen für das nahende Wochenende,
ein hoch erfreuter und nun mit neuem tollen VBA Wissen ausgestatteter Andreas Hanisch.

Beliebteste Forumthreads (12 Monate)

Ausfuellen bis nächsten Wert_unten nach oben

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread