Zellen gleich dem Inhalt der aktiven mit bestimmter Farbe färben

Question

Hallo an alle!

Ich bräuchte unbedingt Hilfe in einer Sache. Mein Problem ist
folgendes:

Ich habe eine Tabelle für die Arbeitseinteilung. Wenn diese voll ist, wird
das ganz ganz schön unübersichtlich.

Ich möchte nun das der Inhalt aller Zellen in einem bestimmten Bereich
mit der "momentan ausgewählten (aktiven) Zelle" überprüft wird. Der
Bereich soll auf die selbe Spalte wie die aktive bezogen sein, kann aber
falls nicht möglich auch auf z.B.: D3-H44 angewandt werden.

Ist der Text ident, soll die Schrift bei den übereinstimmenden mit einem
kräftigen rot eingefärbt werden, um sofort zu erkennen, wie viele Leute
auf dem selben Projekt arbeiten.

Ich hoffe ihr könnt mir helfen. Vielen Dank im Voraus!

Answer 1

hi all ^^

z.b.

gruss nighty

Sub Markierung()
Range(Cells(1, ActiveCell.Column), Cells(ActiveSheet.Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row, ActiveCell.Column)).AutoFilter Field:=1, Criteria1:=ActiveCell
Range(Cells(2, ActiveCell.Column), Cells(ActiveSheet.Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row, ActiveCell.Column)).Font.ColorIndex = 5
Cells(ActiveCell.Row, ActiveCell.Column).AutoFilter
End Sub

Answer 2

hi all ^^

oder in Wechselwirkung :-)

gruss nighty

Sub Markierung()
Range(Cells(1, ActiveCell.Column), Cells(ActiveSheet.Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row, ActiveCell.Column)).AutoFilter Field:=1, Criteria1:=ActiveCell
If ActiveCell.Font.ColorIndex = -4105 Then
Range(Cells(2, ActiveCell.Column), Cells(ActiveSheet.Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row, ActiveCell.Column)).Font.ColorIndex = 5
Else
Range(Cells(2, ActiveCell.Column), Cells(ActiveSheet.Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row, ActiveCell.Column)).Font.ColorIndex = -4105
End If
Cells(1, ActiveCell.Column).AutoFilter
End Sub

Answer 3

hi all ^^

ein Beispiel für einen Bereich in wechselwirkung

gruss nighty

der Bereich waere an 2 Positionen anzupassen

Sub MarkierungBereich()
Dim Suche As Object
Dim firstad As String
If ActiveCell = "" Then
MsgBox "Keine Eingabe"
End
End If
Set Suche = Range("a2:b4").Find(ActiveCell)
If Not Suche Is Nothing Then
firstad = Suche.Address
Else
MsgBox "Suchbegriff nicht gefunden"
End
End If
Do
Set Suche = Range("a2:b4").FindNext(Suche)
If Not Suche Is Nothing Then
If Cells(Suche.Row, Suche.Column).Font.ColorIndex = -4105 Then
Cells(Suche.Row, Suche.Column).Font.ColorIndex = 5
Else
Cells(Suche.Row, Suche.Column).Font.ColorIndex = -4105
End If
End If
Loop While Suche.Address <> firstad
End Sub