Clever-Excel-Forum

Hey Ihr!

Ich habe eine Tabelle; in dieser stehen in Spalte B verschiedene Kalenderwochen (nicht als KW formatiert). Nun möchte ich ein Makro programmieren, das den Benutzer frägt welche KW er aktuell betrachten möchte.
Das Makro soll diese KW dann in Spalte B suchen und den Text dieser Zeile und der Zeilen der 2 darauffolgenden KW rot färben (Schriftfarbe rot). Bei einer neuen Abfrage, soll dann die Schriftfarbe für alles wieder auf schwarz gesetzt werden und 3 neue KW rot eingefärbt werden. Es könnte auch sein, dass KW doppelt vorkommen. Dann werden einfach 4 oder mehr Zeilen eingefärbt.
Ich habe mit dem Makro mal begonnen und die Abfrage der KW läuft auch super. Jedoch weiß ich nicht genau, wie ich es schaffe, dass dann die entsprechende Zeile und vor allem 3 Zeilen eingefärbt werden und es vor jeder neuen Abfrage wieder überall schwarze Schriftfarbe hat.

Vielleicht kann mir von euch ja jemand Tipps oder Anhaltspunkte geben! Ich hoffe, ich habe es halbwegs verständlich erklärt!
Vielen Dank schon mal!
Und hier noch mein Codeversuch!

Code:
Public Sub Rotfärbung()

'aktuelle KW und die 2 danach sollen rot sein; Rest soll schwarz sein; kann auch sein, dass KW öfter vorkommt, dann 4 oder mehr rot einfärben; bei neuer Eingabe, neue 3 rot markieren und alten in schwarz umwandeln

Dim KW As String

Dim SpalteB As Range

KW = InputBox("Bitte die aktuelle KW eingeben:")

If KW = "" Then Exit Sub

SpalteB = Range("B:B")

If SpalteB = KW Then

 With KW.EntireRow

    .Front.ColorIndex = vbRed

 End With

End If

End Sub

Hallöchen,

wenn Du die Farbe zurücksetzen willst, dann färbe einfach alle KW schwarz und nicht nur ausgewählte Smile

In Deinem Makro wird noch nix gesucht und gefunden. Du kannst einfach mal den Code zum Suchen einer KW aufzeichnen. Da steht dann meinetwegen "33" im Code, und das ersetzt Du durch Deine variable KW.

Beim Suchen wird die entsprechende Zelle aktiviert. Dann kannst Du z.B. mit

Activecell.EntireRow.Front.ColorIndex = vbRed

rot setzen. Die Zelle darunter dann z.B. mit

Activecell.Offset(1,0).EntireRow.Front.ColorIndex = vbRed

Hey!

Super, vielen Dank für den Tipp! Damit bin ich schon wirklich weiter gekommen! Ich habe jetzt mal weitergebastelt und es funktioniert tatsächlich schon fast. Jetzt habe ich nur noch ein Problem. Smile

Es kann sein, dass manche KW doppelt vorkommen. Diese werden jedoch nicht erfasst und nur das erste Suchergebnis wird formatiert. Kann ich da an meinem aufgezeichneten Suchcode was verändern, dass alle Werte, die dem Suchbegriff entsprechen, ausgewählt und dann formatiert werden?
Vielen Dank schon mal! Anbei ein Teil des Codes (wenn mehr fürs Verständnis gebraucht wird, gerne Bescheid geben)

Grüße!

Code:
Columns("B:B").Select

        Selection.Find(What:=KW, After:=ActiveCell, LookIn:=xlValues, LookAt:= _

        xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _

        , SearchFormat:=False).Activate

        ActiveCell.EntireRow.Select

        With Selection.Font

            .Color = -16776961

            .TintAndShade = 0

        End With

Hallöchen,

bei mehreren Treffern muss man schauen. Wenn es maximal zwei sind, könntest Du beim Aufzeichnen einfach nochmal "Weitersuchen"
Da kommt in etwa so was raus:

Code:
Sub Makro1()

'

' Makro 1

'

Columns("A:A").Select

Cells.Find(What:="a", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _

    xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _

    , SearchFormat:=False).Activate

Cells.FindNext(After:=ActiveCell).Activate

End Sub

Mit einer Schleife für zwei oder mehr Treffer würde der Code dann so aussehen. Cells(1, 1) ist übrigens A1 --> Cells(Zeile, Spalte)
Activate könnte man übrigens auch noch wegbekommen aber für den Anfang denke ich, geht es auch so Smile

Code:
Sub Makro2()

'Variablendeklaration-Long

Dim iCnt&

'Spalte A ab A1 nach a durchsuchen und Treffer aktivieren

Columns("A:A").Find(What:="a", After:=Cells(1, 1), LookIn:=xlFormulas, LookAt:= _

    xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _

    , SearchFormat:=False).Activate

'Schleife f?r weitere Treffer - solange Zaehler < als Treffer-Zeilennummer

Do While iCnt < ActiveCell.Row

    'hier einfaerben

    '....

    '....

    'Zaehler auf zuvor gefundene Zeilennummer stellen

    iCnt = ActiveCell.Row

    'naechste Fundstelle suchen

    Cells.FindNext(After:=ActiveCell).Activate

'Ende Schleife f?r weitere Treffer - solange Zaehler < als Treffer-Zeilennummer

Loop

End Sub

Uhh, super! Jetzt funktioniert es! Vielen vielen Dank!

phia

schauan

phia

schauan

phia