Werte farblich markieren

Hallo Zusammen!
Ich benötige eure Hilfe!
Ich habe eine Mappe mit diversen Tabellenblättern. Es geht hier hauptsächlich darum das ich auf jedem Blatt, immer an verschiedenen Stellen, Kennzeichen zu stehen habe.
Mein wünsch wäre eine Eingabemaske wo ich genau das gesuchte Kennzeichen (z.B. FOG-4988 oder FOE-1133) eingebe und dann dieses Kennzeichen in jedem Tabellenblatt farblich gekennzeichnet wird. (am liebsten in hellblau code 42 )
Genau die gleiche Eingabemaske wird benötigt um diese Markierung zu einem späteren Zeitpunkt rückgängig zu machen. Es werden teilweise bis zu 70 Datensätze markiert.
es sind ca 350 Datensätze vorhanden, auf einem der Blätter würde ich dann die Schaltflächen/Button´s mit dem entsprechendem Makro einbauen.
Vielen Dank!
Floppe

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub kolorieren() Dim bl As Long Dim c As Range Dim wert As String Dim myFarbe As String wert = InputBox("(1) Eingabe Platzkennziffer", "Abfrage 1/2") If wert = "" Then Exit Sub jn = MsgBox("(2) Die Platzkennziffer " & wert & vbCr _ & " jetzt einfärben = JA " & vbCr & "oder entfärben = NEIN", vbYesNo) If jn 6 Then myFarbe = -4142 Else myFarbe = 42 End If For bl = 1 To Worksheets.Count With Worksheets(bl).UsedRange Set c = .Find(wert, LookIn:=xlValues) If Not c Is Nothing Then firstAddress = c.Address Do c.Interior.ColorIndex = myFarbe Debug.Print Worksheets(bl).Name & vbTab & c.Address Set c = .FindNext(c) Loop While Not c Is Nothing And c.Address firstAddress End If End With Next End Sub

Function CheckNumberplate(Numberplate) 'Max: FOE-1 ... FOE-123456 'CheckNumberplate=TRUE, wenn Syntax O=K, sonst =FALSE Numberplate = UCase(Numberplate) CheckNumberplate = False 'Default Select Case Len(Numberplate) Case Is 10 Exit Function End Select Select Case Left$(Numberplate, 4) Case "FOE-", "FOG-" Case Else Exit Function End Select If Not CheckZiffern(Mid$(Numberplate, 5)) Then Exit Function End If CheckNumberplate = True 'Alles OK! End Function

Private Sub SubToggle(Numberplate As String, TriWirdHellblau As Integer, ShIndx As Integer, Optional ShIndxOrg As Integer) Set Rng = Cells.Find(Numberplate, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)

Hallo,


Sub kolorieren()
Dim bl As Long, c As Range, wert As String
wert = InputBox("(1) Eingabe Platzkennziffer", "Abfrage 1/2")
If Not wert = vbNullString Then
For bl = 1 To Worksheets.Count
With Worksheets(bl).UsedRange
Set c = .Find(wert, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Interior.ColorIndex = 42
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address  firstAddress
End If
End With
Next
End If
Set c = Nothing
End Sub
Sub Farbe_raus()
Dim bl As Long, c As Range, wert As String
wert = InputBox("(1) Eingabe Platzkennziffer", "Abfrage 1/2")
If Not wert = vbNullString Then
For bl = 1 To Worksheets.Count
With Worksheets(bl).UsedRange
Set c = .Find(wert, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Interior.ColorIndex = xlNone
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address  firstAddress
End If
End With
Next
End If
Set c = Nothing
End Sub

Gruß Werner

Beliebteste Forumthreads (12 Monate)

18
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Werte farblich markieren

18 Beiträge zum Forumthread Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

18
Beiträge zum Forumthread

Beiträge zu diesem Forumthread