VBA Identische in Spalte markieren
15.03.2015 09:40:30
WalterK
den folgenden Code habe ich im Internet gefunden. Er markiert in Spalte B alle Namen, die mit dem Namen in der aktiven Zelle übereinstimmen.
Jetzt wollte ich mit Private Sub Worksheet_SelectionChange(ByVal Target As Range) erreichen, dass der Code automatisch startet wenn ich im Bereich B6:B(bis Ende) in eine Zelle klicke. Und das bringe ich nicht zum Laufen.
Hier ist der Code und eine Beispieltabelle:
Option Explicit
Sub IdentischeMarkieren()
Dim sBegriff As String
Dim gzelle As Range
Dim LzB As Long
LzB = Application.Max(6, Cells(Rows.Count, 2).End(xlUp).Row)
ActiveSheet.Range("B6:B" & LzB).Interior.ColorIndex = xlNone
If ActiveCell.Column 2 Or ActiveCell.Value = "" Then
MsgBox "Wähle zuerst einen Werte aus Spalte B.", vbCritical, "FEHLER"
Exit Sub
Else: sBegriff = ActiveCell.Value
End If
Set gzelle = ActiveSheet.Columns("B").Find(What:=sBegriff, LookIn:=xlValues, _
LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=False)
gzelle.Interior.ColorIndex = 37
If Not gzelle Is Nothing Then
gzelle.Activate
Do ' weitersuchen
Columns("B").FindNext(After:=ActiveCell).Activate
If ActiveCell.Row = gzelle.Row And ActiveCell.Column = gzelle.Column Then _
Exit Do ' dann ist er wieder beim ersten Fund
ActiveCell.Offset(0, 0).Interior.ColorIndex = 37
Loop
Set gzelle = Nothing
End If
End Sub
https://www.herber.de/bbs/user/96373.xlsm
Besten Dank im voraus, Servus Walter