Ausfuellen bis nächsten Wert_unten nach oben

Forumthread: Ausfuellen bis nächsten Wert_unten nach oben

18.10.2007 18:37:00

Andreas

Hallo liebes Herber- Team,
ich habe ein Makro, welches innerhalb einer Selektion die Werte von oben nach unten ausfüllt und dabei bis zum nächsten unterschiedlichen Wert den vorherigen nimmt, und dann auf den neuen Wert wechselt und mit diesem weitergeht.


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

Das Makro läuft von oben nach unten. Nun benötige ich diese Aktion jedoch auch noch von unten nach oben. Ich habe schon probiert, c und w einfach "umzustellen/ vertauschen" das führte jedoch in den verschiedenen Varianten zu Fehlermeldungen im Debugger. Einmal lief es durch, löschte jedoch alle Werte. Wo muß ich ansetzen, um die Laufrichtung umzukehren?
Vielen Dank für Eure Mühen und Vorschläge.
Abendliche Grüße,
Andreas Hanisch

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Ausfuellen bis nächsten Wert_unten nach oben

18.10.2007 19:13:00

Gerd

Hi,
das geht mit einer For Each-Schleife nicht. Du musst eine ander Schleif, z.B. Do Loop mit Index
verwenden.
mfg Gerd

AW: Ausfuellen bis nächsten Wert_unten nach oben

18.10.2007 19:19:22

Worti

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

AW: Ausfuellen bis nächsten Wert_unten nach oben

19.10.2007 15:24:00

Andreas

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

Forumthread: Ausfuellen bis nächsten Wert_unten nach oben

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Ausfuellen bis nächsten Wert_unten nach oben

Forumthread: Ausfuellen bis nächsten Wert_unten nach oben

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

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread