Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
492to496
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
492to496
492to496
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Code soll versetzt auch über andere Spalten laufen

Code soll versetzt auch über andere Spalten laufen
03.10.2004 11:05:09
Sabine
Hallo Excel Experten,
ich muß leider schon wieder um Hilfe bitten. Gestern habe ich hier von Ransi diesen Code bekommen, der auch wunderbar funktioniert.
Set acde_C = Range("C3183:C3217")
Set b_C = Range("C3218:C3237")
Set gy_C = Range("C3238:C3252")
Set ur_C = Range("C3253:C3267")
Set or_C = Range("C3268:C3282")
For Each Zelle In Range("C1606:C1746")
If WorksheetFunction.CountIf(acde_C, Zelle) &gt 0 Then Zelle.Font.ColorIndex = 1
If WorksheetFunction.CountIf(b_C, Zelle) &gt 0 Then Zelle.Font.ColorIndex = 3
If WorksheetFunction.CountIf(gy_C, Zelle) &gt 0 Then Zelle.Font.ColorIndex = 5
If WorksheetFunction.CountIf(ur_C, Zelle) &gt 0 Then Zelle.Font.ColorIndex = 7
If WorksheetFunction.CountIf(or_C, Zelle) &gt 0 Then Zelle.Font.ColorIndex = 10
Next
Nun möchte ich das Ganze in den daneben liegenden Spalten bis zur Spalte BF wiederholen.
Also
Set acde_D = Range("D3183:D3217")
Set b_D = Range("D3218:D3237")
Set gy_D = Range("D3238:D3252")
Set ur_D = Range("D3253:D3267")
Set or_D = Range("D3268:D3282")
For Each Zelle In Range("D1606:D1746")
If WorksheetFunction.CountIf(acde_D, Zelle) &gt 0 Then Zelle.Font.ColorIndex = 1
If WorksheetFunction.CountIf(b_D, Zelle) &gt 0 Then Zelle.Font.ColorIndex = 3
If WorksheetFunction.CountIf(gy_D, Zelle) &gt 0 Then Zelle.Font.ColorIndex = 5
If WorksheetFunction.CountIf(ur_D, Zelle) &gt 0 Then Zelle.Font.ColorIndex = 7
If WorksheetFunction.CountIf(or_D, Zelle) &gt 0 Then Zelle.Font.ColorIndex = 10
Next
Set acde_E = Range("E3183:E3217")
Set b_E = Range("E3218:E3237")
Set gy_E = Range("E3238:E3252")
Set ur_E = Range("E3253:E3267")
Set or_E = Range("E3268:E3282")
For Each Zelle In Range("E1606:E1746")
If WorksheetFunction.CountIf(acde_E, Zelle) &gt 0 Then Zelle.Font.ColorIndex = 1
If WorksheetFunction.CountIf(b_E, Zelle) &gt 0 Then Zelle.Font.ColorIndex = 3
If WorksheetFunction.CountIf(gy_E, Zelle) &gt 0 Then Zelle.Font.ColorIndex = 5
If WorksheetFunction.CountIf(ur_E, Zelle) &gt 0 Then Zelle.Font.ColorIndex = 7
If WorksheetFunction.CountIf(or_E, Zelle) &gt 0 Then Zelle.Font.ColorIndex = 10
Next
USW.
Gibt es irgendeine Möglichkeit, das Ganze automatisch auch über die anderen Spalten laufen zu lassen? Z.B. mit so einer Art Schleife. Das Ganze bis zur Spalte BF immer wieder von Hand zu kopieren und entsprechend anzupassen ist nicht nur extrem aufwendig, sondern braucht auch sehr viel Rechnerleistung.

Hoffentlich weiß jemand Rat. Meine VBA Kenntnisse entsprechen leider noch dem Vorschulalter.
MfG
Sabine

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Code soll versetzt auch über andere Spalten la
Reinhard
Hi Sabine,
ungetestet:
For sp = 3 To 58 'Spalten C:BF
Set acde = Range(Cells(3183, sp), Cells(3217, sp))
Set b = Range(Cells(3218, sp), Cells(3237, sp))
Set ur = Range(Cells(3253, sp), Cells(3267, sp))
Set orr = Range(Cells(3268, sp), Cells(3282, sp)) 'or geht nicht da OR von Excel benutzt
For Each Zelle In Range(Cells(1606, sp), Cells(1746, sp))
If WorksheetFunction.CountIf(acde, Zelle) > 0 Then Zelle.Font.ColorIndex = 1
If WorksheetFunction.CountIf(b, Zelle) > 0 Then Zelle.Font.ColorIndex = 3
If WorksheetFunction.CountIf(gy, Zelle) > 0 Then Zelle.Font.ColorIndex = 5
If WorksheetFunction.CountIf(ur, Zelle) > 0 Then Zelle.Font.ColorIndex = 7
If WorksheetFunction.CountIf(orr, Zelle) > 0 Then Zelle.Font.ColorIndex = 10
Next Zelle
Next sp

Gruß
Reinhard
Anzeige
AW: Code soll versetzt auch über andere Spalten la
03.10.2004 12:14:54
Sabine
Hallo Reinhard,
da sitze ich die ganze Nacht und versuche – erfolglos - irgend etwas halbwegs Vernünftiges zustande zu bringen und dann gibt es da Menschen die mein Problem mal eben in fünf Minuten gelöst haben. Der Code läuft prima.
Ich will so was auch können, "heul".
Nein, jetzt mal im ernst.
Vielen herzlichen Dank für Deine Arbeit. Ich finde es wirklich toll, daß ihr Experte ohne jede Gegenleistung dafür zu bekommen, die Probleme anderer Leute löst. Vielleicht kapiere ich VBA ja eines Tages doch noch, und kann dann auch mal bei dem einen oder anderen Problem helfen.
Bis dahin
Mein Respekt und Dank
Herzliche Grüße Sabine
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige