Find befehl mit mehreren Ergebnissen

Dim Bereich As Range Set Bereich = Range(Cells(4, 3), Cells(64, 8)).Find("Test", lookat:=xlPart, LookIn:=xlValues, MatchCase:=True) If Not Bereich Is Nothing Then MsgBox "Das Wort Test ist in Verwendung. Entsprechende Zelle ist rot gefärbt." Range(Bereich.Address).Interior.ColorIndex = 3 Else MsgBox "Keine Verwendung des Wortes" End If

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Kwaki,
hier eine Idee....

Code:


[Cc][+][-]

Sub SuchenUndFaerben()
  Dim oFinde As Object
  Dim sSuch As String, sErsteAdresse As String
  Dim iAnz As Integer, rBer  As Range
    
  sSuch = "Test"
  Set rBer = Range(Cells(4, 3), Cells(64, 8))         ' Suchbereich setzen
  
  Set oFinde = rBer.Find(sSuch, lookat:=xlPart, _
               LookIn:=xlValues, MatchCase:=True)     ' Erstes Feld mit dem Suchbegriff suchen
  
  If Not oFinde Is Nothing Then
     sErsteAdresse = oFinde.Address                   ' Erste Adresse merken
     Do
        Set oFinde = rBer.FindNext(oFinde)
        If oFinde Is Nothing Then Exit Do
        iAnz = iAnz + 1
        oFinde.Interior.ColorIndex = 3                ' Zelle färben
     Loop While Not oFinde Is Nothing And oFinde.Address <> sErsteAdresse
  End If
  
  If iAnz = 0 Then
     MsgBox "Keine Verwendung des Wortes " & sSuch, vbInformation
  Else
     MsgBox "Das Wort '" & sSuch & "' ist " & iAnz & " mal in Verwendung." & vbLf _
          & "Entsprechende Zelle(n) sind rot gefärbt.", vbInformation
  End If
End Sub

_________________________
viele Grüße aus Freigericht 😊
Karl-Heinz

Code: [Cc][+][-] Sub SuchenUndFaerben() Dim oFinde As Object Dim sSuch As String, sErsteAdresse As String Dim iAnz As Integer, rBer As Range sSuch = "Test" Set rBer = Range(Cells(4, 3), Cells(64, 8)) ' Suchbereich setzen Set oFinde = rBer.Find(sSuch, lookat:=xlPart, _ LookIn:=xlValues, MatchCase:=True) ' Erstes Feld mit dem Suchbegriff suchen If Not oFinde Is Nothing Then sErsteAdresse = oFinde.Address ' Erste Adresse merken Do iAnz = iAnz + 1 oFinde.Interior.ColorIndex = 3 ' Zelle färben Set oFinde = rBer.FindNext(oFinde) Loop While Not oFinde Is Nothing And oFinde.Address <> sErsteAdresse End If If iAnz = 0 Then MsgBox "Keine Verwendung des Wortes " & sSuch, vbInformation Else MsgBox "Das Wort '" & sSuch & "' ist " & iAnz & " mal in Verwendung." & vbLf _ & "Entsprechende Zelle(n) sind rot gefärbt.", vbInformation End If End Sub

Dim Bereich As Range, rngFind As Range Dim firstAddress As String Set Bereich = Range(Cells(4, 3), Cells(64, 8)) With Bereich .Interior.Color = xlNone '--erst alles entfaerben Set rngFind = .Find("Test", lookat:=xlPart, LookIn:=xlValues, MatchCase:=True) If Not rngFind Is Nothing Then firstAddress = rngFind.Address Do Cells(rngFind.Row, rngFind.Column).Interior.Color = vbRed Set rngFind = .FindNext(rngFind) Loop While rngFind.Address firstAddress Else MsgBox "kein ""Test"" vorhanden" End If End With

Sub test() Dim Bereich As Range, rngFind As Range Set Bereich = Range(Cells(4, 3), Cells(64, 8)) With Bereich .Interior.Color = xlNone Set rngFind = Bereich(1) Do Set rngFind = Bereich.Find("Test", after:=rngFind, lookat:=xlPart, LookIn:=xlValues, MatchCase:=True) If rngFind Is Nothing Then Exit Do If rngFind.Interior.Color = vbRed Then Exit Do rngFind.Interior.Color = vbRed Loop End With End Sub

Beliebteste Forumthreads (12 Monate)

Find befehl mit mehreren Ergebnissen

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

305 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Find befehl mit mehreren Ergebnissen

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

305 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread