Endlosen code kürzen
07.12.2003 15:35:14
Lorenz
Habe es mit "Case, Select Case" probiert.
Leider nur in der vorliegenden Version lauffähig
So schaut er aus!
Dim B1, B2, B3, B4, B5, B6, B7, B8, B9, B10, B11, B12, B13, B14, B15, B16, B17, B18, B19, B20, B21, B22, B23, B24, B25, B26, B27, B28, B29, B30, B31 As Range
Set B1 = Range("ae5:ae89")
Set B2 = Range("af5:af89")
Set B3 = Range("ag5:ag89")
Set B4 = Range("ah5:ah89")
Set B5 = Range("ai5:ai89")
Set B6 = Range("aj5:aj89")
Set B7 = Range("ak5:ak89")
Set B8 = Range("al5:al89")
Set B9 = Range("am5:am89")
Set B10 = Range("an5:an89")
Set B11 = Range("ao5:ao89")
Set B12 = Range("ap5:ap89")
Set B13 = Range("aq5:aq89")
Set B14 = Range("ar5:ar89")
Set B15 = Range("as5:as89")
Set B16 = Range("at5:at89")
Set B17 = Range("au5:au89")
Set B18 = Range("av5:av89")
Set B19 = Range("aw5:aw89")
Set B20 = Range("ax5:ax89")
Set B21 = Range("ay5:ay89")
Set B22 = Range("az5:az89")
Set B23 = Range("ba5:ba89")
Set B24 = Range("bb5:bb89")
Set B25 = Range("bc5:bc89")
Set B26 = Range("bd5:bd89")
Set B27 = Range("be5:be89")
Set B28 = Range("bf5:bf89")
Set B29 = Range("bg5:bg89")
Set B30 = Range("bh5:bh89")
Set B31 = Range("bi5:bi89")
If Range("ae1") = "1" Then
B1.Interior.ColorIndex = 3
B1.Font.ColorIndex = 2
ElseIf Range("ae2") = "1" Then
B1.Interior.ColorIndex = 5
B1.Font.ColorIndex = 2
Else
B1.Interior.ColorIndex = 0
B1.Font.ColorIndex = 1
End If
If Range("af1") = "1" Then
B2.Interior.ColorIndex = 3
B2.Font.ColorIndex = 2
ElseIf Range("af2") = "1" Then
B2.Interior.ColorIndex = 5
B2.Font.ColorIndex = 2
Else
B2.Interior.ColorIndex = 0
B2.Font.ColorIndex = 1
End If
If Range("ag1") = "1" Then
B3.Interior.ColorIndex = 3
B3.Font.ColorIndex = 2
ElseIf Range("ag2") = "1" Then
B3.Interior.ColorIndex = 5
B3.Font.ColorIndex = 2
Else
B3.Interior.ColorIndex = 0
B3.Font.ColorIndex = 1
End If
If Range("ah1") = "1" Then
B4.Interior.ColorIndex = 3
B4.Font.ColorIndex = 2
ElseIf Range("ah2") = "1" Then
B4.Interior.ColorIndex = 5
B4.Font.ColorIndex = 2
Else
B4.Interior.ColorIndex = 0
B4.Font.ColorIndex = 1
End If
If Range("ai1") = "1" Then
B5.Interior.ColorIndex = 3
B5.Font.ColorIndex = 2
ElseIf Range("ai2") = "1" Then
B5.Interior.ColorIndex = 5
B5.Font.ColorIndex = 2
Else
B5.Interior.ColorIndex = 0
B5.Font.ColorIndex = 1
End If
If Range("aj1") = "1" Then
B6.Interior.ColorIndex = 3
B6.Font.ColorIndex = 2
ElseIf Range("aj2") = "1" Then
B6.Interior.ColorIndex = 5
B6.Font.ColorIndex = 2
Else
B6.Interior.ColorIndex = 0
B6.Font.ColorIndex = 1
End If
If Range("ak1") = "1" Then
B7.Interior.ColorIndex = 3
B7.Font.ColorIndex = 2
ElseIf Range("ak2") = "1" Then
B7.Interior.ColorIndex = 5
B7.Font.ColorIndex = 2
Else
B7.Interior.ColorIndex = 0
B7.Font.ColorIndex = 1
End If
If Range("al1") = "1" Then
B8.Interior.ColorIndex = 3
B8.Font.ColorIndex = 2
ElseIf Range("al2") = "1" Then
B8.Interior.ColorIndex = 5
B8.Font.ColorIndex = 2
Else
B8.Interior.ColorIndex = 0
B8.Font.ColorIndex = 1
End If
If Range("am1") = "1" Then
B9.Interior.ColorIndex = 3
B9.Font.ColorIndex = 2
ElseIf Range("am2") = "1" Then
B9.Interior.ColorIndex = 5
B9.Font.ColorIndex = 2
Else
B9.Interior.ColorIndex = 0
B9.Font.ColorIndex = 1
End If
If Range("an1") = "1" Then
B10.Interior.ColorIndex = 3
B10.Font.ColorIndex = 2
ElseIf Range("an2") = "1" Then
B10.Interior.ColorIndex = 5
B10.Font.ColorIndex = 2
Else
B10.Interior.ColorIndex = 0
B10.Font.ColorIndex = 1
End If
If Range("ao1") = "1" Then
B11.Interior.ColorIndex = 3
B11.Font.ColorIndex = 2
ElseIf Range("ao2") = "1" Then
B11.Interior.ColorIndex = 5
B11.Font.ColorIndex = 2
Else
B11.Interior.ColorIndex = 0
B11.Font.ColorIndex = 1
End If
If Range("ap1") = "1" Then
B12.Interior.ColorIndex = 3
B12.Font.ColorIndex = 2
ElseIf Range("ap2") = "1" Then
B12.Interior.ColorIndex = 5
B12.Font.ColorIndex = 2
Else
B12.Interior.ColorIndex = 0
B12.Font.ColorIndex = 1
End If
If Range("aq1") = "1" Then
B13.Interior.ColorIndex = 3
B13.Font.ColorIndex = 2
ElseIf Range("aq2") = "1" Then
B13.Interior.ColorIndex = 5
B13.Font.ColorIndex = 2
Else
B13.Interior.ColorIndex = 0
B13.Font.ColorIndex = 1
End If
If Range("ar1") = "1" Then
B14.Interior.ColorIndex = 3
B14.Font.ColorIndex = 2
ElseIf Range("ar2") = "1" Then
B14.Interior.ColorIndex = 5
B14.Font.ColorIndex = 2
Else
B14.Interior.ColorIndex = 0
B14.Font.ColorIndex = 1
End If
If Range("as1") = "1" Then
B15.Interior.ColorIndex = 3
B15.Font.ColorIndex = 2
ElseIf Range("as2") = "1" Then
B15.Interior.ColorIndex = 5
B15.Font.ColorIndex = 2
Else
B15.Interior.ColorIndex = 0
B15.Font.ColorIndex = 1
End If
If Range("at1") = "1" Then
B16.Interior.ColorIndex = 3
B16.Font.ColorIndex = 2
ElseIf Range("at2") = "1" Then
B16.Interior.ColorIndex = 5
B16.Font.ColorIndex = 2
Else
B16.Interior.ColorIndex = 0
B16.Font.ColorIndex = 1
End If
If Range("au1") = "1" Then
B17.Interior.ColorIndex = 3
B17.Font.ColorIndex = 2
ElseIf Range("au2") = "1" Then
B17.Interior.ColorIndex = 5
B17.Font.ColorIndex = 2
Else
B17.Interior.ColorIndex = 0
B17.Font.ColorIndex = 1
End If
If Range("av1") = "1" Then
B18.Interior.ColorIndex = 3
B18.Font.ColorIndex = 2
ElseIf Range("av2") = "1" Then
B18.Interior.ColorIndex = 5
B18.Font.ColorIndex = 2
Else
B18.Interior.ColorIndex = 0
B18.Font.ColorIndex = 1
End If
If Range("aw1") = "1" Then
B19.Interior.ColorIndex = 3
B19.Font.ColorIndex = 2
ElseIf Range("aw2") = "1" Then
B19.Interior.ColorIndex = 5
B19.Font.ColorIndex = 2
Else
B19.Interior.ColorIndex = 0
B19.Font.ColorIndex = 1
End If
If Range("ax1") = "1" Then
B20.Interior.ColorIndex = 3
B20.Font.ColorIndex = 2
ElseIf Range("ax2") = "1" Then
B20.Interior.ColorIndex = 5
B20.Font.ColorIndex = 2
Else
B20.Interior.ColorIndex = 0
B20.Font.ColorIndex = 1
End If
If Range("ay1") = "1" Then
B21.Interior.ColorIndex = 3
B21.Font.ColorIndex = 2
ElseIf Range("ay2") = "1" Then
B21.Interior.ColorIndex = 5
B21.Font.ColorIndex = 2
Else
B21.Interior.ColorIndex = 0
B21.Font.ColorIndex = 1
End If
If Range("az1") = "1" Then
B22.Interior.ColorIndex = 3
B22.Font.ColorIndex = 2
ElseIf Range("az2") = "1" Then
B22.Interior.ColorIndex = 5
B22.Font.ColorIndex = 2
Else
B22.Interior.ColorIndex = 0
B22.Font.ColorIndex = 1
End If
If Range("ba1") = "1" Then
B23.Interior.ColorIndex = 3
B23.Font.ColorIndex = 2
ElseIf Range("ba2") = "1" Then
B23.Interior.ColorIndex = 5
B23.Font.ColorIndex = 2
Else
B23.Interior.ColorIndex = 0
B23.Font.ColorIndex = 1
End If
If Range("bb1") = "1" Then
B24.Interior.ColorIndex = 3
B24.Font.ColorIndex = 2
ElseIf Range("bb2") = "1" Then
B24.Interior.ColorIndex = 5
B24.Font.ColorIndex = 2
Else
B24.Interior.ColorIndex = 0
B24.Font.ColorIndex = 1
End If
If Range("bc1") = "1" Then
B25.Interior.ColorIndex = 3
B25.Font.ColorIndex = 2
ElseIf Range("bc2") = "1" Then
B25.Interior.ColorIndex = 5
B25.Font.ColorIndex = 2
Else
B25.Interior.ColorIndex = 0
B25.Font.ColorIndex = 1
End If
If Range("bd1") = "1" Then
B26.Interior.ColorIndex = 3
B26.Font.ColorIndex = 2
ElseIf Range("bd2") = "1" Then
B26.Interior.ColorIndex = 5
B26.Font.ColorIndex = 2
Else
B26.Interior.ColorIndex = 0
B26.Font.ColorIndex = 1
End If
If Range("be1") = "1" Then
B27.Interior.ColorIndex = 3
B27.Font.ColorIndex = 2
ElseIf Range("be2") = "1" Then
B27.Interior.ColorIndex = 5
B27.Font.ColorIndex = 2
Else
B27.Interior.ColorIndex = 0
B27.Font.ColorIndex = 1
End If
If Range("bf1") = "1" Then
B28.Interior.ColorIndex = 3
B28.Font.ColorIndex = 2
ElseIf Range("bf2") = "1" Then
B28.Interior.ColorIndex = 5
B28.Font.ColorIndex = 2
Else
B28.Interior.ColorIndex = 0
B28.Font.ColorIndex = 1
End If
If Range("bg1") = "1" Then
B29.Interior.ColorIndex = 3
B29.Font.ColorIndex = 2
ElseIf Range("bg2") = "1" Then
B29.Interior.ColorIndex = 5
B29.Font.ColorIndex = 2
Else
B29.Interior.ColorIndex = 0
B29.Font.ColorIndex = 1
End If
If Range("bh1") = "1" Then
B30.Interior.ColorIndex = 3
B30.Font.ColorIndex = 2
ElseIf Range("bh2") = "1" Then
B30.Interior.ColorIndex = 5
B30.Font.ColorIndex = 2
Else
B30.Interior.ColorIndex = 0
B30.Font.ColorIndex = 1
End If
If Range("bi1") = "1" Then
B31.Interior.ColorIndex = 3
B31.Font.ColorIndex = 2
ElseIf Range("bi2") = "1" Then
B31.Interior.ColorIndex = 5
B31.Font.ColorIndex = 2
Else
B31.Interior.ColorIndex = 0
B31.Font.ColorIndex = 1
End If
End Sub
Ich hoffe mein Wunsch klingt nicht unverschämt!
Im Voraus Dankend
Lorenz K.