Markierungen

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
InputBox MsgBox
Bild

Betrifft: Markierungen
von: Steffen
Geschrieben am: 30.11.2003 19:12:54

Hallo,

ich habe eine Suchroutine gebastelt, die nach einem Begriff sucht, den man eingegeben hat. Die Zelle, in dem der gesuchte Begriff stehst, wird farblich markiert. Nun möchte ich mittels einer Schaltfläche in dem Arbeitsblatt diese Markierung wieder aufheben, allerdings bekomme ich das nicht hin. Das mit der Schaltfläche ist nicht das PRoblem, bloß das dazugehörige Makro bekomme ich nicht. Den Quellcode der Suche habe ich unten mal angehängt.

Würde mich freuen, wenn jemand Rat weiß.

Gruß

Sven


Private Sub Suchen()
    Dim strSuchtext As String
    Dim objBlatt As Worksheet
    Dim objZelle As Range
    Dim strErsteFundstelle As String
    Dim intButton As Integer
    
    'Zu suchenden Text abfragen; Vorgabe aus Registry lesen
    strSuchtext = Trim(InputBox("Gesuchter Text:", APP_NAME, GetSetting(APP_NAME, "Einstellungen", "Suchtext", "")))
    'Wenn Suchtext angegeben und nicht 'Abbrechen' gewählt, dann...
    If strSuchtext > "" Then
        '... Suchtext in Registry speichern
        SaveSetting APP_NAME, "Einstellungen", "Suchtext", strSuchtext
        'Alle Blätter durchlaufen
        For Each objBlatt In ActiveWorkbook.Worksheets
            'Verwendeten Bereich jedes Blatts durchsuchen
            With objBlatt.UsedRange
                'Suchfunktion aufrufen
                Set objZelle = .Find(What:=strSuchtext, LookIn:=xlValues)
                'Wenn erster Treffer, dann...
                If Not objZelle Is Nothing Then
                    '... Fundstelle merken
                    strErsteFundstelle = objBlatt.Name & "!" & objZelle.Address
                    Do
                        'Blatt mit Fundstelle aktivieren
                        objBlatt.Activate
                        'Fundstelle markieren
                        'objZelle.Select
                        objZelle.Interior.ColorIndex = 35
                        'Anwender fragen, ob Suche fortgesetzt werden soll
                        intButton = MsgBox("Weiter suchen?", vbQuestion + vbYesNoCancel, APP_NAME)
                        'Wenn Antwort nicht 'Ja' lautet, dann...
                        If intButton <> vbYes Then
                            '... Makro beenden
                            Exit Sub
                        End If
                        'Nach nächstem Vorkommen suchen
                        Set objZelle = .FindNext(objZelle)
                    'Schleife wiederholen solange weitere Fundstellen auftauchen und erste Fundstelle noch nicht erreicht
                    Loop While Not objZelle Is Nothing And objBlatt.Name & "!" & objZelle.Address <> strErsteFundstelle
                End If
            End With
        Next
        MsgBox "Keine weiteren Fundstellen.", vbInformation, APP_NAME
    End If
End Sub

Bild


Betrifft: AW: Markierungen
von: Klaus
Geschrieben am: 01.12.2003 08:47:29

Moin,

alles markieren, dann

Selection.Interior.ColorIndex = xlNone

Gruss

Klaus


Bild


Betrifft: AW: Markierungen
von: Nabriss
Geschrieben am: 01.12.2003 09:13:08

Hallo Moin
Oder So:

Sub Suchen1()
    Dim strSuchtext As String
    Dim objBlatt As Worksheet
    Dim objZelle As Range
    Dim strErsteFundstelle As String
    Dim intButton As Integer
    'Zu suchenden Text abfragen; Vorgabe aus Registry lesen
   strSuchtext = Trim(InputBox("Gesuchter Text:", APP_NAME, GetSetting(APP_NAME, "Einstellungen", "Suchtext", "")))
 'Wenn Suchtext angegeben und nicht 'Abbrechen' gewählt, dann...
    If strSuchtext > "" Then
        '... Suchtext in Registry speichern
'        SaveSetting APP_NAME, "Einstellungen", "Suchtext", strSuchtext
        'Alle Blätter durchlaufen
        For Each objBlatt In ActiveWorkbook.Worksheets
            'Verwendeten Bereich jedes Blatts durchsuchen
            With objBlatt.UsedRange
                'Suchfunktion aufrufen
                Set objZelle = .Find(What:=strSuchtext, LookIn:=xlValues)
                'Wenn erster Treffer, dann...
                If Not objZelle Is Nothing Then
                    '... Fundstelle merken
                    strErsteFundstelle = objBlatt.Name & "!" & objZelle.Address
                    Do
                        'Blatt mit Fundstelle aktivieren
                        objBlatt.Activate
                        'Fundstelle markieren
                        'objZelle.Select
                        objZelle.Interior.ColorIndex = xlNone
                        Set objZelle = .FindNext(objZelle)
                    'Schleife wiederholen solange weitere Fundstellen auftauchen und erste Fundstelle noch nicht erreicht
                    Loop While Not objZelle Is Nothing And objBlatt.Name & "!" & objZelle.Address <> strErsteFundstelle
                End If
            End With
        Next
        MsgBox "Keine weiteren Fundstellen.", vbInformation, APP_NAME
    End If
End Sub

Gruß
Nabriss


Bild


Betrifft: AW: Markierungen
von: Steffen
Geschrieben am: 02.12.2003 20:01:18

Hallo,

ich möchte dieses "Markierung aufheben" über einen Button über eine eigene Sub ralisieren. Da funktioniert das irgendwie nicht (objZelle.Interior.ColorIndex = xlNone). Ich denke, ich werde dann die werte von objZelle übergeben müssen oder?
Leider bin ich noch nicht so fit das hin zubekommen. Kann ich auch einfach alle markierten Zellen suchen und die Markierung aufheben.
Gruß
Steffen


Bild


Betrifft: AW: Markierungen
von: Steffen
Geschrieben am: 02.12.2003 19:55:50

Hallo,

vielen dank erstmal,
aber wie kann ich denn alles markieren?


Gruß
Steffen


Bild


Betrifft: AW: Markierungen
von: Nabriss
Geschrieben am: 03.12.2003 11:20:07


Hallo Moin,

Cells.Select
Gruß
Nabriss


Bild


Betrifft: Markierungen-Vielen Dank
von: Steffen
Geschrieben am: 03.12.2003 11:37:51

Hallo,

Vielen Dank. Funktioniert ja prima.

Vielen Dank für die Hilfe.

Gruß
Steffen


Bild

Beiträge aus den Excel-Beispielen zum Thema " Markierungen"