Endlosen code kürzen

Bild

Betrifft: Endlosen code kürzen
von: Lorenz
Geschrieben am: 07.12.2003 15:35:14

Hallo!
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.

Bild


Betrifft: AW: Endlosen code kürzen
von: Hans W. Hofmann
Geschrieben am: 07.12.2003 16:00:58

Werklich, total brutal Dein Code...

Dim i As Integer
For i = 31 To 58
 With Range(Cells(5, i), Cells(89, i))
    If Cells(1, i) = 1 Then
        .Interior.ColorIndex = 3
        .Font.ColorIndex = 2
        ElseIf Cells(2, i) = "1" Then
            .Interior.ColorIndex = 5
            .Font.ColorIndex = 2
        Else
            .Interior.ColorIndex = 0
            .Font.ColorIndex = 1
    End If
 End With
Next
 

Gruß HW


Bild


Betrifft: Das ist eleganter :-)) o.T.
von: Ramses
Geschrieben am: 07.12.2003 16:08:03

...


Bild


Betrifft: Dank an Ramses & HW
von: Lorenz K.
Geschrieben am: 07.12.2003 16:16:35

Hallo ihr!
Danke für`s überarbeiten!
Selbstverständlich werde ich daraus lernen um euch ein solches "Codezeugs" wie ich es erstellte in Zukunft zu ersparen.

Nochmals Danke und Grüße aus Österreich von
Lorenz K.


Bild


Betrifft: AW: Endlosen code kürzen
von: Ramses
Geschrieben am: 07.12.2003 16:07:16

Hallo Lorenz


Option Explicit

Sub check_Value_for_Colour()
Dim i As Integer
Dim z1 As Integer, z2 As Integer
Dim Start As Integer, Ende As Integer
z1 = 1
z2 = 2
Start = 5 'Begin Bereich
Ende = 89 'Ende Bereich
For i = 31 To 61 '31 = AE, 61 = BI
    If Cells(z1, i) = 1 Then
        Range(Cells(Start, i), Cells(Ende, i)).Interior.ColorIndex = 3
        Range(Cells(Start, i), Cells(Ende, i)).Font.ColorIndex = 2
    ElseIf Cells(z2, i) = 1 Then
        Range(Cells(Start, i), Cells(Ende, i)).Interior.ColorIndex = 5
        Range(Cells(Start, i), Cells(Ende, i)).Font.ColorIndex = 2
    Else
        Range(Cells(Start, i), Cells(Ende, i)).Interior.ColorIndex = 0
        Range(Cells(Start, i), Cells(Ende, i)).Font.ColorIndex = 1
    End If
Next i
End Sub 
     Code eingefügt mit Syntaxhighlighter 1.16



Gruss Rainer


Bild


Betrifft: AW: Endlosen code kürzen ...Laufzeitfehler
von: Lorenz K.
Geschrieben am: 07.12.2003 16:35:56

Hallo HWH & or Ramses!

Beide Var. ausprobiert und beide verursachen einen Laufzeitfehler 13
(Typen unverträglich)
Woran kann`s liegen????
Grüsse Lorenz


Bild


Betrifft: AW: Endlosen code kürzen ...Laufzeitfehler
von: Ramses
Geschrieben am: 07.12.2003 17:41:15

Hallo

Welche Zeile wird markiert
Bei mir läuft der Code problemlos !?

Gruss Rainer


Bild


Betrifft: AW: Endlosen code kürzen ...Laufzeitfehler
von: Lorenz K.
Geschrieben am: 07.12.2003 19:47:03

Hallo!!
Bin schon(erst kürzlich) draufgekommen was schuld war!

Der in Zeile 1 bzw Zeile 2 belegte Zellenbereich war mit einer Formel belegt,
welche den Wert "1" od. "0" ausgeben sollte. Der Wert 1 war klar definiert, der Wert "0"
war aber "" (beliebig), somit glaube ich lag es an "Integer".
Nachdem ich die Formel korrigierte funzte es.

Danke Lorenz


Bild


Betrifft: Merci :-)) Geschlossen o.T.
von: Ramses
Geschrieben am: 07.12.2003 20:36:02

...


Bild

Beiträge aus den Excel-Beispielen zum Thema " Excel-Funktionen in Englisch und Deutsch"