Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender

Forumthread: mehrer Werte in Bereich suchen.

mehrer Werte in Bereich suchen.
28.06.2004 01:14:16
Thomas
Hallo Leute.
Ich möchte im Bereich F10:T40 einer Tabelle 4 festgelegte Werte suchen, das sind A1, A2, A3 und A4.
Diese Werte können bis zu 3x vorkommen, aber auch gar nicht.
Die Zellen mit diesen Werten sollen dann unterschiedliche Schriftfarben bekommen, alos A1 soll dann rot werden, A2 grün, A3 blau und A4 gelb.
Gibts da ne schnelle, kurze VBA-Lösung?
Bedingte Formatierung funzt ja leider nicht, da es um 4 Werte geht.
MfG
Thomas
Anzeige

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: mehrer Werte in Bereich suchen.
WernerB.
Hallo Thomas,
was hältst Du hiervon?

Sub Thomas()
Dim c As Range
Application.ScreenUpdating = False
Range("F10:T40").Font.ColorIndex = 0
For Each c In Range("F10:T40")
If c.Text = Range("A1").Text Then
c.Font.ColorIndex = 3
ElseIf c.Text = Range("A2").Text Then
c.Font.ColorIndex = 10
ElseIf c.Text = Range("A3").Text Then
c.Font.ColorIndex = 5
ElseIf c.Text = Range("A4").Text Then
c.Font.ColorIndex = 6
End If
Next c
Application.ScreenUpdating = True
End Sub

Viel Erfolg wünscht
WernerB.
Anzeige
AW: mehrer Werte in Bereich suchen.
Josef
Hallo Thomas!
Füge einen CommandButton ein und weise ihm diesen Code zu.

Private Sub CommandButton1_Click()
Dim rngC As Range
Dim rngBereich As Range
Dim intC As Integer
Dim vFind As Variant
Dim vColor() As Variant
Dim sfirst As String
vColor = Array(3, 4, 5, 6)              'Farben rot, grün, blau, gelb
Set rngBereich = Range("F10:T40")       'Suchbereich
rngBereich.Interior.ColorIndex = xlNone 'Farbe zurücksetzen
vFind = Range("A1:A4")                  'Array der Suchbegriffe
For intC = 1 To 4
Set rngC = rngBereich.Find(What:=vFind(intC, 1), _
LookIn:=xlValues, LookAt:=xlWhole)
If Not rngC Is Nothing Then
sfirst = rngC.Address
rngC.Interior.ColorIndex = vColor(intC - 1) 'Hintergrundfarbe zuweisen
Do
Set rngC = rngBereich.FindNext(after:=rngC) 'Suche nach weiteren Fundstellen
If Not rngC Is Nothing Then
If rngC.Address = sfirst Then Exit Do
rngC.Interior.ColorIndex = vColor(intC - 1) 'Hintergrundfarbe zuweisen
End If
Loop
End If
sfirst = ""
Set rngC = Nothing
Next
Set rngBereich = Nothing
Set rngC = Nothing
End Sub

Gruß Sepp
Anzeige
Du wolltest ja die Schriftfarbe ändern...
Josef
...dann muss es so heisen!

Private Sub CommandButton1_Click()
Dim rngC As Range
Dim rngBereich As Range
Dim intC As Integer
Dim vFind As Variant
Dim vColor() As Variant
Dim sfirst As String
vColor = Array(3, 4, 5, 6)                  'Farbenarray - rot, grün, blau, gelb
Set rngBereich = Range("F10:T40")           'Suchbereich
rngBereich.Font.ColorIndex = xlAutomatic    'Schriftfarbe zurücksetzen
vFind = Range("A1:A4")                      'Array der Suchbegriffe
For intC = 1 To 4
Set rngC = rngBereich.Find(What:=vFind(intC, 1), _
LookIn:=xlValues, LookAt:=xlWhole)
If Not rngC Is Nothing Then
sfirst = rngC.Address
rngC.Font.ColorIndex = vColor(intC - 1) 'Schriftfarbe zuweisen
Do
Set rngC = rngBereich.FindNext(after:=rngC) 'Suche nach weiteren Fundstellen
If Not rngC Is Nothing Then
If rngC.Address = sfirst Then Exit Do
rngC.Font.ColorIndex = vColor(intC - 1) 'Schriftfarbe zuweisen
End If
Loop
End If
sfirst = ""
Set rngC = Nothing
Next
Set rngBereich = Nothing
Set rngC = Nothing
End Sub

Gruß Sepp
Anzeige
AW: mehrer Werte in Bereich suchen.
28.06.2004 08:31:08
Uwe
Hallo Thomas,
hier mein Vorschlag:

Sub ZellenFaerben()
Dim varWert(1 To 4)
Dim byteZ As Byte
Dim byteCol As Byte
Dim rngBereich As Range
Dim rngZelle As Range
For byteZ = 1 To 4
varWert(byteZ) = Cells(byteZ, 1)
Next byteZ
Set rngBereich = Range("F10:T40")
rngBereich.Font.ColorIndex = xlAutomatic
For Each rngZelle In rngBereich.Cells
For byteZ = 1 To 4
If rngZelle = varWert(byteZ) Then
rngZelle.Font.ColorIndex = Choose(byteZ, 3, 4, 5, 6)
Exit For
End If
Next byteZ
Next rngZelle
End Sub

Gruß Uwe
Anzeige
;

Forumthreads zu verwandten Themen

Anzeige
Anzeige
Anzeige
Entdecke relevante Threads

Schau dir verwandte Threads basierend auf dem aktuellen Thema an

Alle relevanten Threads mit Inhaltsvorschau entdecken
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige