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

VBA Farbe Code

VBA Farbe Code
28.09.2007 14:20:00
Maiks
Hallo Excel-Freunde,
zur Fabe-Füllung bestimmte Bereich eine Excel Datei, habe ein Code geschrieben.
diese funktioniert so weit super gut.
nur das Problem ist, bei Erweiterung die Bereiche wird der Code zu lang. und habe ein Fehler Meldung " Sub zu Groß".
hier habe ich meine Datei hochgeladen: https://www.herber.de/bbs/user/46420.xls
(diese funktioniert gut, nur kann ich keine weiter Bereich mehr zufügen)
hab ich nun mit hilf von zwei Variablen " i und k" meine code in eine "Schleife For-Next mit If-Funktion" versucht zu schreiben. leider irgendwie klap das nicht.
hier ist meine Code, bitte sage sie mir was ich falsch mache?
ich glaube meine Problem ist bei der Definition der Range
Vielen Dank im voraus

Private Sub Worksheet_Change(ByVal Targel As Range)
On Error GoTo Fehler
Application.ScreenUpdating = False
Dim i As Integer
Dim k As Integer
For i = 17 To 110
For k = 1 To 26
If Cells(i, k) = "Monteur" Then
Range(Cells(i - 9, k), Cells(i - 2, k)).Interior.ColorIndex = 3
ElseIf Cells(i, k) = "Umrüsten" Or Cells(i, k) = "Einstellen" Or Cells(i, k) = " _
Einrichten" Then
Range(Cells(i - 9, k), Cells(i - 2, k)).Interior.ColorIndex = 27
ElseIf Cells(i, k) = "hoch Prio" Then
Range(Cells(i - 9, k), Cells(i - 2, k)).Interior.ColorIndex = 35
ElseIf Cells(i, k) = "Keine Teile" Then
Range(Cells(i - 9, k), Cells(i - 2, k)).Interior.ColorIndex = 38
ElseIf Cells(i, k) = "kein Bedarf" Then
Range(Cells(i - 9, k), Cells(i - 2, k)).Interior.ColorIndex = 15
ElseIf Cells(i, k) = "" And Cells(i - 10, k) = "steht" Then
Range(Cells(i - 9, k), Cells(i - 2, k)).Interior.ColorIndex = 15
Else
Range(Cells(i - 9, k), Cells(i - 2, k)).Interior.ColorIndex = 37
Exit For
End If
Next k
Next i
Fehler:
Application.ScreenUpdating = True
End Sub


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

Betreff
Datum
Anwender
Anzeige
AW: VBA Farbe Code
28.09.2007 14:44:56
Rudi
Hallo,
sowas macht man mit Select Case.

Private Sub Worksheet_Change(ByVal Targel As Range)
On Error GoTo Fehler
Application.ScreenUpdating = False
Dim i As Integer
Dim k As Integer
For i = 17 To 110
For k = 1 To 26
Select Case Cells(i, k)
Case "Monteur"
Range(Cells(i - 9, k), Cells(i - 2, k)).Interior.ColorIndex = 3
Case "Umrüsten", "Einstellen", " Einrichten "
Range(Cells(i - 9, k), Cells(i - 2, k)).Interior.ColorIndex = 27
Case "hoch Prio"
Range(Cells(i - 9, k), Cells(i - 2, k)).Interior.ColorIndex = 35
Case "Keine Teile"
Range(Cells(i - 9, k), Cells(i - 2, k)).Interior.ColorIndex = 38
Case "kein Bedarf"
Range(Cells(i - 9, k), Cells(i - 2, k)).Interior.ColorIndex = 15
Case ""
If Cells(i - 10, k) = "steht" Then
Range(Cells(i - 9, k), Cells(i - 2, k)).Interior.ColorIndex = 15
Else
Range(Cells(i - 9, k), Cells(i - 2, k)).Interior.ColorIndex = 37
End If
End Select
Next k
Next i
Fehler:
Application.ScreenUpdating = True
End Sub


Gruß
Rudi
Eine Kuh macht Muh, viele Kühe machen Mühe

Anzeige
AW: VBA Farbe Code
28.09.2007 15:11:00
Maiks
Hallo Rudi,
vielen Dank! für deine schnelle Anwort.
ich habe der neue Code mit " Select Case" probiert, funktioniert noch nicht richtig. ich wollte damit sagen, dass die Fabe Füllung sind nicht Bereich gezielt, wie ich wollte.
zb. der Code füllt die Fabe .Interior.ColorIndex = 37 (hier Blassblau) in der ganze Bereich A8:Z108
irgendwas stimmt nicht mit der Variable od. mit die dynamische range od. die Schleifen nicht. ich suche lange schon, aber finde ich nicht.
danke für die Hilfe

VBA Farbe Code
28.09.2007 16:38:00
Maiks
hallo Zusammen,
hab ich die Lösung gefunden.
danke an Rudi Maintaire
hier ist der neue Code, falls es jemand interessiert
servus

Private Sub Worksheet_Change(ByVal Targel As Range)
On Error GoTo Fehler
Application.ScreenUpdating = False
Dim i As Integer
Dim k As Integer
For i = 17 To 113 Step 16
For k = 1 To 26
Select Case Cells(i, k)
Case "Monteur"
Range(Cells(i - 9, k), Cells(i - 2, k)).Interior.ColorIndex = 3
Case "Umrüsten", "Einstellen", "Einrichten"
Range(Cells(i - 9, k), Cells(i - 2, k)).Interior.ColorIndex = 27
Case "hoch Prio"
Range(Cells(i - 9, k), Cells(i - 2, k)).Interior.ColorIndex = 35
Case "Keine Teile"
Range(Cells(i - 9, k), Cells(i - 2, k)).Interior.ColorIndex = 38
Case "kein Bedarf"
Range(Cells(i - 9, k), Cells(i - 2, k)).Interior.ColorIndex = 15
Case "läuft"
Range(Cells(i - 9, k), Cells(i - 2, k)).Interior.ColorIndex = 37
Case Else
If Cells(i - 10, k) = "steht" Then
Range(Cells(i - 9, k), Cells(i - 2, k)).Interior.ColorIndex = 15
Else
Range(Cells(i - 9, k), Cells(i - 2, k)).Interior.ColorIndex = 2
End If
End Select
Next k
Next i
Fehler:
Application.ScreenUpdating = True
End Sub


Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige