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

Bedingung prüfen_String suchen_Färben&Zurückfärben

Bedingung prüfen_String suchen_Färben&Zurückfärben
04.10.2007 16:59:32
Andreas
Hallo Herber Fans,
ich habe ein Makro Problem, auf das ich auch schon eine (Teil-) Lösung erhalten habe. Diese an neue Erfordernisse anzupassen gelingt mir jedoch nicht.
Aufgabe:
In einer umfangreichen Datei sollen Zwischensummen von Projekten farblich markiert werden. Dies schon beim Finden eines Strings (Eingabe in C1). Diese Zwischensummen sind auf der sog. Konsolidierungsebene 1. Auf Ebene 0 sind alle Einzelpositionen vermerkt. Diese sollen nicht gefärbt werden. Das Makro soll sich nur auf Zeilen der Ebene 1 bewegen.
Dies wäre über bedingte Formatierung (Formel ist; $A3 = 1 UND FINDEN(String)) sehr gut möglich. In einer Variante der Originaldatei auch schon umgesetzt. Aber das automatische Berechnen ist in dieser Datei aufgrund der umfangreichen Formeln deaktiviert. (Rechenzeiten von mehreren Minuten). Also greift auch bedingte Formatierung mit Formeln nicht. Deshalb Makro.
Beispieldatei
https://www.herber.de/bbs/user/46532.xls
Ich möchte anmerken, daß dieses in der Datei vorhandene Makro von Peter F. am 20.09.2007 entwickelt wurde und sehr gut funktioniert. Nochmals meine Wertschätzung für Peters Lösung an dieser Stelle!
Ich poste auch nur noch einmal, weil sich die Rahmenbedingungen geändert haben und ich diese nicht abzubilden fähig bin.
Die Zwischensummen sind aufgrund von Layoutvorgaben nun hellgelb. Wenn der Suchstring gefunden wurde, springt die betreffende Zeile auf Gold (Colorindex = 44). Wenn der Suchstring nicht mehr aktuell ist, soll sie aber wieder auf hellgelb springen. Das bekomme ich nicht hin.
Meine Ansatz:
Ich habe diese Zeile aus dem Makro:
WkSh.Range("A3:B" & WkSh.Range("B65536").End(xlUp).Row).Interior.ColorIndex = xlNone
auf Colorindex 36 gesetzt, anstatt xlNone. Aber woran ich mich bisher erfolglos versuchte war noch das Einbringen der Kondition „Wenn Zelle in Spalte A“ = 1, dann Colorindex 36.
Also habe ich die Befehlszeile: „If WkSh.Range("A" & rZelle.Row).Value = 1 Then“ noch davor gesetzt um die Kondition „nur auf Colorindex 36 setzten, wenn Ebene 1“ abzubilden.
Aber das war nach dem Verfahren „Versuch und Irrtum“ und so konnte ich die Fehlermeldungen nicht lösen. Der Debugger hat fleißig diese Zeile eingefärbt und gemeldet, daß der IF Block fehlerhaft ist, wahlweise auch mal die With Anweisung. Ich muß nun kapitulieren. Ich kenne zu wenig über das Zusammenspiel und die Verträglichkeiten der definierten Bereiche, respektive mein VBA Wissen ist noch lange nicht ausreichend…
Ich würde mich freuen, wenn ich aus dem Forum eine Rückmeldung erhalte, was ich tun muß, um mein Problem zu lösen. Zu Erfahren welche Komponenten des Makros unverträglich sind, daß es nach meinen Änderungen nicht funktioniert.
Vielen Dank und Grüße,
Andreas Hanisch, Berlin

12
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Verständnisfrage:
04.10.2007 19:56:39
{Boris}
Hi Andreas,
sehe ich das richtig:
Spalte A = 1 und Spalte B enthält den Suchstring aus C1: Gold färben (Colorindex 44)
Spalte A = 1 und Spalte B enthält den Suchstring aus C1 nicht: Colorindex 36
In allen anderen Fällen gar keine Farbe.
Korrekt?
Grüße Boris

AW: Bedingung prüfen_String suchen_Färben&Zurückfärben
04.10.2007 20:09:27
{Boris}
Hi Andreas,
da ich jetzt Schluss mache - unter den von mir angesprochenen Bedingungen - ein ganz anderer Code, der auf den Autofilter aufsetzt (noch ohne Fehlerbehandlung):
Option Explicit

Sub machs()
Dim lngLastRow As Long
Application.ScreenUpdating = False
With Tabelle1
lngLastRow = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("A3:C" & lngLastRow).Interior.ColorIndex = xlNone
.Range("A2").AutoFilter Field:=1, Criteria1:="1"
.Range("A3:C" & lngLastRow).Interior.ColorIndex = 36
.ShowAllData
.Range("A2").AutoFilter Field:=1, Criteria1:="1"
.Range("A2").AutoFilter Field:=2, Criteria1:="*" & .Cells(1, 2) & "*"
.Range("A3:C" & lngLastRow).Interior.ColorIndex = 44
.ShowAllData
End With
Application.ScreenUpdating = True
End Sub


Grüße Boris

Anzeige
Doppelte...
04.10.2007 20:18:00
{Boris}
...ShowAllData-Anweisung - natürlich überflüssig:
Option Explicit

Sub machs()
Dim lngLastRow As Long
Application.ScreenUpdating = False
With Tabelle1
lngLastRow = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("A3:C" & lngLastRow).Interior.ColorIndex = xlNone
.Range("A2").AutoFilter Field:=1, Criteria1:="1"
.Range("A3:C" & lngLastRow).Interior.ColorIndex = 36
.Range("A2").AutoFilter Field:=2, Criteria1:="*" & .Cells(1, 2) & "*"
.Range("A3:C" & lngLastRow).Interior.ColorIndex = 44
.ShowAllData
End With
Application.ScreenUpdating = True
End Sub


Grüße Boris

Anzeige
AW: Doppelte...
05.10.2007 09:03:00
Andreas
Hallo Boris,
Vielen Dank für Deinen Lösungsansatz. Ich habe Dein Makro gerade eingesetzt und Stück für Stück getestet. Die Idee, es über AutoFilter zu lösen finde ich sehr gut. Es funktioniert auch soweit. Aber wenn der Suchstring aus B1 nicht vorhanden ist, färbt er alles in Colorindex 44. Das sollte nicht sein. Wenn der String nicht vorhanden ist, soll nichts passieren.
Ich habe alle Blöcke bis auf die Färbungen auskommentiert. Nur die Filterkommandos selektieren die korrekten Zeilen. Nämlich keine, wenn der Suchstring nicht da ist, aber warum dennoch Zeilen gefärbt werden, ist mir ein Rätsel.
Vielleicht weißt Du noch Rat.
Grüße, Andreas

Anzeige
Dann z.B. so...
05.10.2007 09:13:08
{Boris}
Hi Andreas,
Option Explicit

Sub machs()
Dim lngLastRow As Long
Application.ScreenUpdating = False
With Tabelle1
lngLastRow = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("A3:C" & lngLastRow).Interior.ColorIndex = xlNone
.Range("A2").AutoFilter Field:=1, Criteria1:="1"
.Range("A3:C" & lngLastRow).Interior.ColorIndex = 36
If WorksheetFunction.CountIf(Range("B3:B10000"), "*" & .Cells(1, 2) & "*") Then
.Range("A2").AutoFilter Field:=2, Criteria1:="*" & .Cells(1, 2) & "*"
.Range("A3:C" & lngLastRow).Interior.ColorIndex = 44
End If
.ShowAllData
End With
Application.ScreenUpdating = True
End Sub


Grüße Boris

Anzeige
AW: Dann z.B. so...
05.10.2007 10:10:19
Andreas
Hi Boris,
es läuft! Ich habe das Makro nun in die wesentlich größere "Produktiv" Datei eingefügt und die Bezüge so angepaßt, daß sie im dortigen Layout laufen. Dabei ist mir eine Sache aufgefallen. Wenn das Makro durchgelaufen ist, werden alle Gruppierungen expandiert. Das das ein Problem sein könnte, war mir bis dato nicht bewußt, aber in der Datei für die dieses Makro sein soll, sind es 160 Zeilen der Ebene 1, die jeweils 39 Zeilen der Ebene 0 umfassen. Wenn das Makro nun durchgelaufen ist, dann wird alles expandiert und ich habe 160x39 Zeilen offen. Das ist zuviel und macht die versuchte Übersichtlichkeit durch String- Suche und Färbung zunichte. Gibt es eine Möglichkeit, daß die zum Zeitpunkt der Makroaktivierung eingestellte Gruppierung erhalten bleibt?
Ehrlich gesagt, habe ich schon fast ein schlechtes Gewissen, weil meine Fragen und Anmerkungen so kleckerweise kommen, aber ich kann die Originaldatei leider nicht posten. Ich denke das mit den Gruppierungen ist dann aber auch die letzte Klippe.
Hast Du eine Idee wie man das umgehen kann?
Auf jeden Fall danke ich Dir schon jetzt für Dein Makro. Wie man AutoFilter über Makros ansteuert hatte ich auch noch auf meiner "Muß ich mir mal ansehen" Liste. Davon habe ich nun eine Ahnung...
Dank und Gruß, Andreas

Anzeige
AW: Dann z.B. so...
05.10.2007 10:25:50
{Boris}
Hi Andreas,
Gruppierung und Autofilter beissen sich ja nun ein wenig:
Sobald man über den Autofilter "Alle" auswählt, werden auch alle vorher eingestellten Gruppierungen extrahiert. Wie läuft das also bei Dir genau mit den Gruppierungen und der Verwendung des Autofilters?
Grüße Boris

AW: Dann z.B. so...
05.10.2007 12:27:00
Andreas
Hallo Boris,
primär ist es so, daß ich über die Gruppierung arbeite. Diese ist bspw. komplett komprimiert auf Ebene 1, ich sehe also 160 Zeilen. Nun habe ich eine Reihe von emails, in denen mir die Projektleiter sagen, was zu welchem Projekt aktuell ist. Das trage ich dort in Kommentarfelder neben das Budget ein. Um nun schnell zu sehen, welche Gruppierung ich expandieren muß, um das Kommentar einzupflegen, benötige ich die Einfärbung. Um zu sehen, in welchem Kontext das Projekt eingebettet ist, kann ich es nicht über Autofilter anzeigen lassen, die vor- und nachgelagerten Projekte müssen sichtbar sein, um korrekte Entscheidungen treffen zu können. Primär also über Gruppierung. Wenn ich ein konkretes Projekt weiter analysieren möchte, dann verwende ich auch den Autofilter.
Ich hoffe das spezifiziert mein Problem noch weiter. In dem Makro in meiner geposteten Datei werden vor der Suche alle Farb Markierungen auf xlNone gesetzt. Da die nachgelagerte Suche in diesem Makro nur auf Ebene 1 stattfindet und dann der String auf colorindex 44 gesetzt wird, macht es vielleicht Sinn, anstelle xlNone prüfen zu lassen. If interior.colorindex = 44 then interior colorindex = 36. So werden nur Farben rückgesetzt wo früher auch einmal gesucht wurde. Dann prüfen, ob der String drin ist und wieder auf Colorindex = 44 setzen. Ich habe damit experimentiert, aber nicht hinbekommen.
Was meinst Du? Läßt sich die Unverträglichkeit von Gruppierung und AutoFilter umgehen oder sollte der erste Makroansatz weiterverfolgt werden.
Grüße, Andreas

Anzeige
Der erste Ansatz...
05.10.2007 14:26:00
{Boris}
Hi Andreas,
...funktioniert aber auch nur, wenn Zeilen gruppiert sind. Sind sie mit dem Autofilter gefiltert, dann sucht die Find-Methode nur in den sichtbaren Zeilen - und das kann auch zu falschen Einfärbungen führen.
Alternativ kann man auch mit einer For-Next-Schleife arbeiten. Das sollte man aber nur tun, wenn es nicht zu viele Datensätze sind. Teste die Performance mal. Bei 2000 Datensätzen in Deiner Beispieldatei waren es bei mir 0,3 Sekunden.

Option Explicit
Sub faerben_mit_for_next()
Dim lRow As Long, x As Long
Dim strSuchbegriff As String
With Tabelle1
strSuchbegriff = "*" & UCase(.Cells(1, 2)) & "*"
lRow = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("A3:C" & lRow).Interior.ColorIndex = xlNone
For x = 3 To lRow
If .Cells(x, 1) = 1 And UCase(.Cells(x, 2)) Like strSuchbegriff Then
.Range("A" & x, "C" & x).Interior.ColorIndex = 44
ElseIf .Cells(x, 1) = 1 Then
.Range("A" & x, "C" & x).Interior.ColorIndex = 36
End If
Next x
End With
End Sub


Grüße Boris

Anzeige
AW: Der erste Ansatz...
05.10.2007 16:50:00
Andreas
Lieber Boris,
Danke, Danke, Danke!
Ich habe Dein Makro nun getestet und es läuft. Ich bin immer noch fasziniert und "von den Socken". Der Ansatz sieht ganz anders aus, es ist kurz, knackig und läuft sehr gut. Auch in der großen Datei mit über 7.500 Zeilen. Ich werde noch weiter damit experimentieren, um es auch ein wenig zu verstehen.
Ich bin sehr erleichtert, daß es doch noch eine Lösung gab und Du mir so gut geholfen hast.
Vielen Dank.
Mit den besten Wünschen für das bevorstehende Wochenende.
Andreas Hanisch, Berlin
PS: Wie kannst Du Aktivitäten am Rechner bis auf 0,3 Sekunden genau zeitlich erfassen?

Anzeige
Laufzeit eines Makros bestimmen
05.10.2007 23:05:48
{Boris}
Hi Andreas,
Wie kannst Du Aktivitäten am Rechner bis auf 0,3 Sekunden genau zeitlich erfassen?
Das kann man zum Beispiel mit der API-Funktion GetTickCount erledigen. Sie gibt die Zeit in Millisekunden seit dem Windows-Start zurück. Packst Du sie zu Beginn in eine Variable, am Ende in eine andere Variabel und subtrahierst dann schließlich EndeVariable-BeginnVariable, dann hast Du die Dauer.

Option Explicit
Private Declare Function GetTickCount Lib "kernel32" () As Long
Sub faerben_mit_for_next()
Dim lRow As Long, x As Long
Dim strSuchbegriff As String
Dim lngStart As Long, lngEnd As Long
lngStart = GetTickCount
With Tabelle1
strSuchbegriff = "*" & UCase(.Cells(1, 2)) & "*"
lRow = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("A3:C" & lRow).Interior.ColorIndex = xlNone
For x = 3 To lRow
If .Cells(x, 1) = 1 And UCase(.Cells(x, 2)) Like strSuchbegriff Then
.Range("A" & x, "C" & x).Interior.ColorIndex = 44
ElseIf .Cells(x, 1) = 1 Then
.Range("A" & x, "C" & x).Interior.ColorIndex = 36
End If
Next x
End With
lngEnd = GetTickCount
MsgBox "Dauer in Millisekunden: " & lngEnd - lngStart, , "Gebe bekannt..."
End Sub


Grüße Boris

Anzeige
AW: Laufzeit eines Makros bestimmen
08.10.2007 11:13:44
Andreas
Hallo Boris,
vielen Dank. Das ist ein sehr guter Tip. Werde die Zeitmessung nun während der Entwicklung von Dateien mitlaufen lassen, um die Rechenzeiten zu optmieren.
Dir einen guten Start in die Woche.
Grüße, Andreas

308 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige