Schleife erstellen?
27.09.2005 19:34:14
Erich
wie kann ich nachstehend (siehe im Code) eine Schleife einbauen?
Mit dem Code werden Zahlen eingefärbt.
Sub färben2()
Dim Zelle As Range, lngR As Long, lngC As Long
Dim RaBereich As Range, RaZelle As Range, iRow As Integer, i As Integer
' Bereich der Wirksamkeit
Set RaBereich = Range("a4:J" & Cells(1, 17))
Application.ScreenUpdating = False
For Each RaZelle In RaBereich
' überprüfen ob Zelle im vorgegebenen Bereich
If Not Intersect(RaZelle, RaBereich) Is Nothing Then
RaZelle.Font.ColorIndex = 0
Select Case RaZelle.Value
''''? Schleife Zeile 5 bis 70 ?
Case Is = Cells(5, 92).Value
RaZelle.Font.ColorIndex = Cells(5, 94)
Case Is = Cells(6, 92).Value
RaZelle.Font.ColorIndex = Cells(6, 94)
Case Is = Cells(7, 92).Value
RaZelle.Font.ColorIndex = Cells(7, 94)
Case Is = Cells(8, 92).Value
RaZelle.Font.ColorIndex = Cells(8, 94)
Case Is = Cells(9, 92).Value
RaZelle.Font.ColorIndex = Cells(9, 94)
Case Is = Cells(10, 92).Value
RaZelle.Font.ColorIndex = Cells(10, 94)
Case Is = Cells(11, 92).Value
RaZelle.Font.ColorIndex = Cells(11, 94)
Case Is = Cells(12, 92).Value
RaZelle.Font.ColorIndex = Cells(12, 94)
Case Is = Cells(13, 92).Value
RaZelle.Font.ColorIndex = Cells(13, 94)
Case Is = Cells(14, 92).Value
RaZelle.Font.ColorIndex = Cells(14, 94)
Case Is = Cells(15, 92).Value
RaZelle.Font.ColorIndex = Cells(15, 94)
End Select
End If
Next RaZelle
Set RaBereich = Nothing
Calculate
UserForm1.Hide
Application.ScreenUpdating = True
End Sub
Besten Dank für eine Hilfe!
mfg
Erich
EXCEL-Shareware und Freeware: http://www.toolex.de
Private Tippgemeinschaft für Lotto oder KENO: http://www.kenostrategen.de