Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
648to652
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
648to652
648to652
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Zellen einfärben

Zellen einfärben
10.08.2005 22:06:06
Erich
Hallo EXCEL-Freunde,
habe aus dem Forum nachstehendes Makro, das ich anpassen möchte:
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim gezogen As Range, zeile As Long, Zelle As Range, tip1 As Range
Dim tip2 As Range, tip3 As Range, tip4 As Range, tip5 As Range
Dim tip1und2 As Range
On Error Resume Next
If Target.Count > 1 Or Target.Row = 1 Or Target.Column <> 7 Then Exit Sub
gezogen.Interior.ColorIndex = xlNone
zeile = Target.Row
Set tip1 = Sheets("Ränge").Range("F2:F21")
Set tip2 = Sheets("gezZahlen").Range("B479:U479")
Set tip1und2 = Sheets("Ränge").Range("F2:F21") And Sheets("gezZahlen").Range("B479:U479")
Set gezogen = Range(Cells(zeile, 1), Cells(zeile, 5))
For Each Zelle In gezogen
If WorksheetFunction.CountIf(tip1, Zelle.Value) > 0 Then Zelle.Interior.ColorIndex = 38
If WorksheetFunction.CountIf(tip2, Zelle.Value) > 0 Then Zelle.Interior.ColorIndex = 6
' If WorksheetFunction.CountIf(tip1und2, Zelle.Value) = 1 Then Zelle.Interior.ColorIndex = 37
' If WorksheetFunction.CountIf(tip1und2, Zelle.Value) = 0 Then Zelle.Interior.ColorIndex = xlNone '2
Next
End Sub

Es soll erreicht werden, wenn eine Zahl sowohl in tip1 als auch in tip2 enthalten ist,
dass dann die Farbe "37" gefüllt wird und wenn in beiden tips die Zahl der
Zelle nicht zu finden ist, dann "entfäfben" =xlNone.
Leider funktionierts nicht, trotz diverser Änderungen.
Besten Dank für eine Hilfe!
mfg
Erich
EXCEL-Shareware und Freeware: http://www.toolex.de
Die Alternative zu Lotto ist KENO: http://www.kenostrategen.de

16
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Zwischenlösung
11.08.2005 07:12:39
Erich
Hallo EXCEL-Freunde,
bin einen Schritt weiter; Problem im Code mit "?" beschrieben:
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim gezogen As Range, zeile As Long, Zelle As Range, tip1 As Range
Dim tip2 As Range, tip3 As Range, tip4 As Range, tip5 As Range
Dim tip1und2 As Range
On Error Resume Next
If Target.Count > 1 Or Target.Row = 1 Or Target.Column <> 7 Then Exit Sub
gezogen.Interior.ColorIndex = xlNone
zeile = Target.Row
Set tip1 = Sheets("Ränge").Range("F2:F21")
Set tip2 = Sheets("gezZahlen").Range("B480:U480")
Set gezogen = Range(Cells(zeile, 1), Cells(zeile, 5))
For Each Zelle In gezogen
Zelle.Interior.ColorIndex = xlNone ' alle werden entfärbt

If WorksheetFunction.CountIf(tip1, Zelle.Value) = 1 _
Then Zelle.Interior.ColorIndex = 38 'lila; tip1 wird lila
If WorksheetFunction.CountIf(tip2, Zelle.Value) = 1 _
Then Zelle.Interior.ColorIndex = 6 ' gelb; tip2 wird gelb

If WorksheetFunction.CountIf(tip2, Zelle.Value) _
Or WorksheetFunction.CountIf(tip1, Zelle.Value) > _
1 Then Zelle.Interior.ColorIndex = 37 '? blau; tip1 und tip2 soll blau werden?
'''auch ...And ... geht nicht !!!

Next
End Sub

Besten Dank nochmal!
mfg
Erich
EXCEL-Shareware und Freeware: http://www.toolex.de
Die Alternative zu Lotto ist KENO: http://www.kenostrategen.de
Anzeige
AW: Zwischenlösung
11.08.2005 09:35:29
Herbert
hallo Erich,
vielleicht schaust du dir einmal die Variable "gezogen" an,
da ist kein Blatt angegeben...
daher bezieht sich "zelle.Interior..." nur auf dieses Blatt...
vielleicht brauchst du noch mehr Schleifen...
weil du schreibst tip1 u. tip2 soll blau werden...
dann mußt du halt so schreiben:
tip1.Interior.ColorIndex = 37
tip2.Interior.ColorIndex = 37
oder meinst du einzelne Zellen in tip1 und tip2 ?
gruß Herbert
AW: Zellen einfärben
11.08.2005 09:53:10
Erich
Hallo auch Erich,
müsste so gehen: If WorksheetFunction.CountIf(tip2, Zelle.Value) _ * WorksheetFunction.CountIf(tip1, Zelle.Value) > 0 Then Zelle.Interior.ColorIndex = 37 ElseIf WorksheetFunction.CountIf(tip2, Zelle.Value) _ + WorksheetFunction.CountIf(tip1, Zelle.Value) = 0 Then Zelle.Interior.ColorIndex = xlNone End If
Die Zeile
"gezogen.Interior.ColorIndex = xlNone"
vor
"zeile = Target.Row"
verursacht einen Fehler - "gezogen" ist hier noch nicht belegt.
Die Zeile "On Error Resume Next" sollstest du auf jeden Fall löschen - sie überdekct den genannten Fehler.
zu Herberts Bemerkung:
gezogen ist definiert als Bereich (Spalten 1 bis 5 der Zeile, in zu der Target gehört) im aktuellen Blatt.
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Anzeige
AW: Zellen einfärben
11.08.2005 10:09:54
Herbert
hallo Erich G.,
ja,das war ja mein Hinweis,daß sich "gezogen" nur auf das aktuelle Blatt bezieht...
er will aber Zellen auf anderen Blättern färben...
gruß Herbert
AW: Zellen einfärben
11.08.2005 12:10:24
Erich
Hallo Herbert,
welche Zellen tatsächlich gefärbt werden sollen, hast du ja schon bei Erich nachgefragt.
Vielleicht hilft eine etwas kürzere Version der bisherigen Prozedur bei der Klärung:
Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim gezogen As Range, zeile As Long, Zelle As Range Dim tip1 As Range, tip2 As Range Dim anz1 As Long, anz2 As Long If Target.Count > 1 Or Target.Row = 1 Or Target.Column <> 7 Then Exit Sub Set tip1 = Sheets("Ränge").Range("F2:F21") Set tip2 = Sheets("gezZahlen").Range("B4:U4") zeile = Target.Row Set gezogen = Range(Cells(zeile, 1), Cells(zeile, 5)) For Each Zelle In gezogen anz1 = WorksheetFunction.CountIf(tip1, Zelle.Value) anz2 = WorksheetFunction.CountIf(tip2, Zelle.Value) If anz1 * anz2 Then Zelle.Interior.ColorIndex = 37 ' Treffer in tip1 und tip2: blau ElseIf anz1 Then Zelle.Interior.ColorIndex = 38 ' Treffer in tip1: lila ElseIf anz2 Then Zelle.Interior.ColorIndex = 6 ' Treffer in tip2: gelb Else Zelle.Interior.ColorIndex = xlNone ' kein Treffer: entfärben End If Next Zelle End Sub
(anz1 und anz2 habe ich eingeführt, damit der Countif nicht unnötig oft ausgeführt werden muss.)
Grüße von Erich aus Kamp-Lintfort
Anzeige
AW: Zellen einfärben
11.08.2005 13:26:33
Herbert
hallo Erich,
nachgefragt habe ich gar nichts,das waren nur Hinweise...
wozu soll ich etwas nachfragen...
nachfragen muß er,nicht ich...
das man das noch anders,besser programmieren kann ist auch klar...
wenn du dir dafür Zeit genommen hast,ist es auch schön...
es gibt immer mehrere Wege zum Glück... :-)
gruß Herbert
GENIAL !!
11.08.2005 19:51:33
Erich
Hallo zusammen,
allerbesten Dank für die Mühen. Die Lösung von Erich habe ich probiert und funktioniert super.
Erklärungsbedarf hätte ich noch:
wieso heisst das anz1 * anz2 ?
Bedeutet das wenn 0*0 dann keine Farbe?
Aber wenn 1*0 dann ist es doch auch 0 ?
mfg
Erich
EXCEL-Shareware und Freeware: http://www.toolex.de
Die Alternative zu Lotto ist KENO: http://www.kenostrategen.de
Anzeige
AW: GENIAL !!
11.08.2005 20:13:14
Erich
Hallo Namensvetter,
If anz1 * anz2 Then
steht kurz für
If (anz1 > 0) And (anz2 > 0) then
oder auch
If (anz1 * anz2) > 0 then
Damit das Produkt anz1*anz2 nicht Null ist, müssen beide Werte größer Null sein, d.h. Treffer in beiden Bereichen.
Wenn mindestens einer der beiden Werte Null ist, dann auch das Produkt - also kein Doppeltreffer.
Der Else-Fall handelt nur noch ab, dass beide Anzahlen Null sind - also "entfärben".
Grüße von Erich aus Kamp-Lintfort
DANKE Erich - jetzt alles klar!
11.08.2005 20:20:42
Erich
mfg
Erich
EXCEL-Shareware und Freeware: http://www.toolex.de
Die Alternative zu Lotto ist KENO: http://www.kenostrategen.de
Anzeige
AW: GENIAL !!
11.08.2005 21:49:34
Herbert
hallo Erich G.
ich habe mir das jetzt interessehalber nochmal angeschaut,
habe es mir am Vormittag eher nur flüchtig angeschaut...
ich habe jetzt die zweite Version von Erich und deine Version probiert,
machen eigentlich beide das gleiche, und funktionieren auch beide...
diese Zeile
"gezogen.Interior.ColorIndex = xlNone"
verursacht zwar eine Fehlermeldung,weil "gezogen noch nicht definiert ist,
aber durch "On Error Resume Next" spielt das keine Rolle...
warum es bei ihm nicht funktioniert hat,
kann ich mir nicht erklären...
zumindest hat er jetzt eine bessere Version erhalten,
das auf jeden Fall...
gruß Herbert
Anzeige
AW: GENIAL !!
11.08.2005 22:59:13
Erich
Hallo Herbert,
das Problem in Erichs 2. Version war in der letzten If-Anweisung:

If WorksheetFunction.CountIf(tip2, Zelle.Value) _
Or WorksheetFunction.CountIf(tip1, Zelle.Value) > _
1 Then Zelle.Interior.ColorIndex = 37
Statt "> 1" hätte da "> 0" (oder wie bei tip2 gar nichts) stehen müssen, mit And statt Or hätte es dann wohl gefunzt.
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
AW: GENIAL !!
12.08.2005 01:38:58
Herbert
hallo Erich,
ja das stimmt,in der letzten If-Anweisung lag der Hund...
da hätte man aus Or nur ein + machen müssen...
dann hätte es in seiner Version auch funktioniert...


Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim gezogen As Range, zeile As Long, Zelle As Range, tip1 As Range
Dim tip2 As Range
If Target.Count > 1 Or Target.Row = 1 Or Target.Column <> 7 Then Exit Sub
zeile = Target.Row
Set tip1 = Sheets("Ränge").Range("F2:F21")
Set tip2 = Sheets("gezZahlen").Range("B4:U4")
Set gezogen = Range(Cells(zeile, 1), Cells(zeile, 5))
    gezogen.Interior.ColorIndex = xlNone
For Each Zelle In gezogen
  If WorksheetFunction.CountIf(tip2, Zelle.Value) = 1 Then
     Zelle.Interior.ColorIndex = 6   'gelb
  End If
  If WorksheetFunction.CountIf(tip1, Zelle.Value) = 1 Then
     Zelle.Interior.ColorIndex = 38   'rosa
  End If
  If WorksheetFunction.CountIf(tip2, Zelle.Value) + _
    WorksheetFunction.CountIf(tip1, Zelle.Value) > 1 Then
    Zelle.Interior.ColorIndex = 37   'lila
  End If
Next
End Sub

     gruß Herbert
Anzeige
Ergänzungsfrage
12.08.2005 06:38:27
Erich
Hallo EXCEL-Freunde,
danke für die weitere Diskussion und Klarstellung. Welche Variante wäre denn bzgl.
Schnelligkeit / Speicherplatz die bessere?
Ferner würde mich interessieren:
Die Zeile B4:U4 ist flexibel, d.h. die Zeile verändert sich; die Spalten B:U bleiben gleich.
Die Veränderung sieht so aus, dass jede Zeile einen Spieltag umfasst und jeder Spieltag führt dazu, dass aus 4 dann 5, aus 5 dann 6 wird usw.
Damit das nicht so einfach ist, ist eine Formel hinterlegt. Ich mache das am Beispiel der
Zeilen 479 bis 484 deutlich:
Zahlen Ersatz
 ABCDE
47909.08.0523811
48010.08.0527918
48111.08.053101112
48212.08.050000
48313.08.050000
48415.08.050000
Formeln der Tabelle
A479 : =+gezZahlen!A479
B479 : =+'D:\Excel\HOBBY\Keno\[Zahlen.xls]Zahlen'!B479
C479 : =+'D:\Excel\HOBBY\Keno\[Zahlen.xls]Zahlen'!C479
D479 : =+'D:\Excel\HOBBY\Keno\[Zahlen.xls]Zahlen'!D479
E479 : =+'D:\Excel\HOBBY\Keno\[Zahlen.xls]Zahlen'!E479
A480 : =+gezZahlen!A480
B480 : =+'D:\Excel\HOBBY\Keno\[Zahlen.xls]Zahlen'!B480
C480 : =+'D:\Excel\HOBBY\Keno\[Zahlen.xls]Zahlen'!C480
D480 : =+'D:\Excel\HOBBY\Keno\[Zahlen.xls]Zahlen'!D480
E480 : =+'D:\Excel\HOBBY\Keno\[Zahlen.xls]Zahlen'!E480
A481 : =+gezZahlen!A481
B481 : =+'D:\Excel\HOBBY\Keno\[Zahlen.xls]Zahlen'!B481
C481 : =+'D:\Excel\HOBBY\Keno\[Zahlen.xls]Zahlen'!C481
D481 : =+'D:\Excel\HOBBY\Keno\[Zahlen.xls]Zahlen'!D481
E481 : =+'D:\Excel\HOBBY\Keno\[Zahlen.xls]Zahlen'!E481
A482 : =+gezZahlen!A482
B482 : =+'D:\Excel\HOBBY\Keno\[Zahlen.xls]Zahlen'!B482
C482 : =+'D:\Excel\HOBBY\Keno\[Zahlen.xls]Zahlen'!C482
D482 : =+'D:\Excel\HOBBY\Keno\[Zahlen.xls]Zahlen'!D482
E482 : =+'D:\Excel\HOBBY\Keno\[Zahlen.xls]Zahlen'!E482
A483 : =+gezZahlen!A483
B483 : =+'D:\Excel\HOBBY\Keno\[Zahlen.xls]Zahlen'!B483
C483 : =+'D:\Excel\HOBBY\Keno\[Zahlen.xls]Zahlen'!C483
D483 : =+'D:\Excel\HOBBY\Keno\[Zahlen.xls]Zahlen'!D483
E483 : =+'D:\Excel\HOBBY\Keno\[Zahlen.xls]Zahlen'!E483
A484 : =+gezZahlen!A484
B484 : =+'D:\Excel\HOBBY\Keno\[Zahlen.xls]Zahlen'!B484
C484 : =+'D:\Excel\HOBBY\Keno\[Zahlen.xls]Zahlen'!C484
D484 : =+'D:\Excel\HOBBY\Keno\[Zahlen.xls]Zahlen'!D484
E484 : =+'D:\Excel\HOBBY\Keno\[Zahlen.xls]Zahlen'!E484
 
Diagramm - Grafik - Excel Tabellen einfach im Web darstellen    Excel Jeanie HTML  3.0    Download  
Es soll immer die Zeile angesprochen (geprüft) werden, die als letzte in Spalte B eine
Zahl größer 0 hat.
Geht das?
Besten Dank!
mfg
Erich
EXCEL-Shareware und Freeware: http://www.toolex.de
Die Alternative zu Lotto ist KENO: http://www.kenostrategen.de
Anzeige
AW: Ergänzungsfrage
12.08.2005 09:19:38
Erich
Hallo auch Erich,
die letzte Zeile mit einem Wert > 0 in Spalte B bekommst du so:
Set tip1 = Sheets("Ränge").Range("F2:F21")
zeile = Application.Evaluate("=MAX(('gezZahlen'!B1:B65000>0)*ROW(1:65000))")
Set tip2 = Sheets("gezZahlen").Range("B" & zeile & ":U" & zeile)
(tip1 ist unverändert, die Variable "zeile" hab ich hier noch mal verwendet, sie wird danach mit "Target.Row" neu belegt.)
Zur Geschwindigkeit:
Ich denke, dass meine Version schneller ist. In deiner Version wird die Farbe einer Zelle mit "Doppeltreffer" vier Mal geändert, erst wird sie zusammen mit den anderen entfärbt, dann treffen alle Bedingeungen zu).
Eine Beschleunigung könntest du vielleicht auch noch dadurch erreichen, dass du die "CountIf"s durch "Find"-Aufrufe ersetzt. Du brauchst ja nur die Info, OB eine Zahl gefunden wird, nicht WIE OFT.
Grüße von Erich aus Kamp-Lintfort
Anzeige
AW: Ergänzungsfrage
12.08.2005 15:38:40
Erich
Hallo Erich,
danke - funktioniert.
Allerdings wird die Färbung mit dieser Variante deutlich langsamer.
Das mit Find werde ich mal testen - muss ich einfach CountIf durch Find ersetzen?
(werds beim probieren merken)
Besten Dank!
mfg
Erich
EXCEL-Shareware und Freeware: http://www.toolex.de
Die Alternative zu Lotto ist KENO: http://www.kenostrategen.de
AW: Ergänzungsfrage
12.08.2005 16:22:25
Erich
Hallo Erich,
ein wenig beschleunigen kannst du, indem du in
MAX(('gezZahlen'!B1:B65000>0)*ROW(1:65000))")
die 65000 durch eine kleinere max. Zeile ersetzt.
Ein Tipp zu Find: Die Methode gibt ein Range (nennen wirs mal rg) zurück, bei "rg Is Nothing" wurde nichts gefunden, sonst ja.
Grüße von Erich aus Kamp-Lintfort

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige