Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1576to1580
1576to1580
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Suchtreffer hervorheben - wieder altes Format

Forumthread: Suchtreffer hervorheben - wieder altes Format

Suchtreffer hervorheben - wieder altes Format
25.08.2017 10:19:49
STeve
Wünsche einen guten Morgen und hätte wieder mal eine Bitte an euch Profis:
Der Suchbutton (geht durch alle Blätter) in dieser Datei funktioniert perfekt:
https://www.herber.de/bbs/user/115737.xlsm
....bräuchte aber dass wenn ein Suchtreffer angezeigt (die Zelle also aktiv ist) wird, diese Zelle hervorgehoben wird.
Bei Klick auf Weitersuchen ja/nein...soll die Zelle wieder in den alten Formatzustand gesetzt werden .......und (wenn auf ja geklickt) der nächste Treffer hervorgehoben werden usw.
Sowas in der Art (hier wird die jeweils aktive Zelle gelb hervorgehoben aber wenn man selbst eine Zelle anklickt) befindet sich in dieser Datei:
https://www.herber.de/bbs/user/115738.xlsm
Wenn die Suche abgebrochen/beendet wird soll die aktive Zelle nicht mehr so hervorgehoben werden.
Fazit:
Die Orginaldatei hat auch 3 Blätter. Jedes Blatt ca. 1000 Zeilen und bis 10 Spalten.
Bei normaler Anzeige ist der Treffer zu schwer zu sehen bzw. fast nicht zu entdecken.
Ideal wäre z.B. der grelle und auffallende Zustand in Datei 115737 - Zelle G10.
Besten Dank und hoffe habe mich verständlich ausgedrückt.
mfg STeve
Anzeige

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Suchtreffer hervorheben - wieder altes Format
25.08.2017 12:50:03
Piet
Hallo Steve
ich habe mal probiert die Aufgabe mit gefundene Zelle Farblich markieren zu optimieren. Dann fiel mir auf das es auch farbliche Zellen gibt! Schau mal ob meine Idee "fcOld" alter Farbcode in der Praxis klappt. Das Makro soll den alten Code wiederherstellen. Ich mache aber nach dem Durchlauf keine Wiederholungsabfrage!!
Ich habe die MsgBoxen ein wenig anders programmiert, mit -vbCancel- für kompletten Programm Abbruch.
Dann laueft das Makro nicht durch alle Tabellen. Meine Art Codes zuschreiben untercheidet sich auch von deiner. Ich rücke bei If Then die Syntax ein, damit ich sehe was zu diesem If Then gehört. Besonders wenn mehrere ineinander laufen ist das m.E. übersichtlicher.
Vorsicht vor dem End Befehl !! - dieser Befehl stoppt alle laufenden Makros in allen geöffneten Dateien !!
Wenn du am Arbeitsplatz andere Dateien am laufen hast Finger weg von dem Befehl. - Dann Exit Sub nehmen!!
mfg Piet
'**  Warnung vor End Befehl - der löscht alle Excel Makros !!!
Private Sub CommandButton1_Click()
Dim ws As Worksheet
Dim SSearch As Variant, ok As Variant
Dim c As Object, fcOld As Variant
Dim firstAddress As String
Dim secAddress As Object
SSearch = InputBox("Gib deinen Suchbegriff ein 8-):", "SUCHMASCHINE", SSearch)
If SSearch = "" Then Exit Sub
'**  Warnung vor End Befehl - der kitt alle Excel Makros !!!
Anf:  'erneut suchen
For Each ws In Worksheets
With ws.Cells
fcOld = xlNone   'Standard Wert
Set c = .Find(SSearch, LookIn:=xlValues, MatchCase:=False)
If Not c Is Nothing Then
ws.Select
c.Select
fcOld = c.Interior.ColorIndex
c.Interior.ColorIndex = 3
firstAddress = c.Address
Set secAddress = c
ok = MsgBox("Weitersuchen?", vbQuestion + vbYesNoCancel)
'** bei No + Cancel Farbe wiederherstellen !!
If ok = vbNo Or ok = vbCancel Then
c.Interior.ColorIndex = fcOld
If ok = vbCancel Then Exit Sub  'Progr.Abbruch
End If
If ok = vbYes Then   'weiter mit Do Loop
Do
secAddress.Interior.ColorIndex = fcOld
Set c = .FindNext(c)
If c.Address = firstAddress Then Exit Do
Set secAddress = c
c.Select
fcOld = c.Interior.ColorIndex
c.Interior.ColorIndex = 3
ok = MsgBox("Weitersuchen?", vbQuestion + vbYesNoCancel)
If ok = vbCancel Then Exit Sub  'Programmabbruch !!
If ok = vbNo Then Exit Do       'Abbruch Do Loop
Loop Until c.Address = firstAddress
'letzte Zelle immer löschen
secAddress.Interior.ColorIndex = fcOld
End If
End If
End With
Next ws
End Sub

Anzeige
Danke an hary und Piet.......
25.08.2017 21:08:54
STeve
Hallo hary und Piet....Danke für eure Mühen und so schnellen Antworten.
Der Code von Piet ist perfekt.
Habe nur noch die ganz grelle Farbe einstellen (die hatte hary :-))
und
beim klick auf nein - auch sofort den Abbruch herbeiführen
eingeben müssen
und somit bin ich voll zufrieden.
...... euch noch ein super schönes WE
mfg STeve
Anzeige
;

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige