Makro Vervollständigung

Question

Hallo @ all,

Ich habe ein Telefonverzeichnis erstellt,
und eine Suchfunktion als Makro hinzugefügt.

Das sieht bis jetzt so aus:

Sub Suche()
Dim Suchbegriff As String
Suchbegriff = InputBox("Name des Kontaktes eingeben.", "Suchen nach:")
Cells.Find(What:=Suchbegriff).Activate
End Sub

Mit dem Makro wird nun das gesammte TB durchsucht.
Ich mochte aber nur Spalte "A" als Suchkriterium haben (mit Range hab ich es leider nicht hinbekommen) und zudem auch nur alle Enträge die in meinem TB "rot" Text sind.
Ist das möglich, dies in das bestehende Makro zu integrieren?
Oder muss man was neues bauen?

danke für eure Hilfe

Gruß Benjamin

Answer 1

Hallo Benjamin,

Option Explicit

Sub Suche()
Dim Suchbegriff As String
Suchbegriff = InputBox("Name des Kontaktes eingeben.", "Suchen nach:")
Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).Find(What:=Suchbegriff).Interior.ColorIndex = 3
End Sub

Gruß
Rainer

Answer 2

Hallo Benjamin,

anbei noch eine Erweiterung, welche die Zellfärbung des vorhergehenden Suchergebnisses löscht.

[code]Option Explicit

Sub Suche()
Dim Suchbegriff As String
Suchbegriff = InputBox("Name des Kontaktes eingeben.", "Suchen nach:")
With Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
    .Interior.ColorIndex = xlNone
    .Find(What:=Suchbegriff).Interior.ColorIndex = 3
End With
End Sub[/code]

Gruß
Rainer

Answer 3

Hallo Benjamin,

die gefundenen Zellen bekommen eine hellblaue Hintergrundfarbe (Zeile: Gefunden.Interior.ColorIndex = 20
), die erste wird aktiviert (Zeile: If Anz = 0 Then Gefunden.Activate).

Option Explicit

Sub Suche()
Dim Suchbegriff As String
Dim Gefunden As Range
Dim Adr1 As String
Dim Anz As Integer

Suchbegriff = InputBox("Name eingeben.", "Suchen nach:")
Anz = 0

With ActiveSheet.Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
Set Gefunden = .Find(Suchbegriff, LookIn:=xlValues)
If Not Gefunden Is Nothing Then
Adr1 = Gefunden.Address
Do
If Gefunden.Font.ColorIndex = 3 Then
If Anz = 0 Then Gefunden.Activate
Gefunden.Interior.ColorIndex = 20
Anz = Anz + 1
End If
Set Gefunden = .FindNext(Gefunden)
Loop While Not Gefunden Is Nothing And Gefunden.Address <> Adr1
End If
MsgBox CStr(Anz) & " Zelle(n) gefunden", , "Suche nach '" & Suchbegriff & "' beendet"
End With

End Sub

MfG
Klaus

Answer 4

Hallo,

@ Rainer:
vielen Dank für deine Mühe, nur leider haben wir uns glaub ich etwas falsch verstanden.
Das Makro sollte mir nur die Namen die ich schon Schriftfarbe &quot;rot&quot; eingepflegt habe durchsuchen.
Nich die Zelle &quot;rot&quot; färben.
sonst läuft es super!

@ Klaus:
Danke! mit einen kleinen Anpassung (Zellfärbung und MsgBox raus) Hat das genauso hin wie ich das brauche.

MfG
Benjamin