Zahl in Spalte suchen und 3 Zeilen rot färben
#1
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
Top
#2
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
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Top
#3
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
Top
#4
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
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Top
#5
Uhh, super! Jetzt funktioniert es! Vielen vielen Dank!
Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste