Alternative zu If-Anweisung

[joshua]

Hallo Community!

Ich hoffe ihr könnt mir mal wieder helfen (:

Ziel ist es, eine definierte Farbe einem Feld zuzuordnen, je nachdem welche Kombination in Spalte G&I zu finden ist.

Ich habe es zu Beginn ganz klassisch mit unzähligen If-Anweisungen versucht. Dies hat auch geklappt, es war aber nicht die eleganteste Methode.
Dann habe ich hier den Tipp bekommen, den Code mithilfe von Arrays zu minimieren/ optimieren.
Dies klappt nun auch (fast) wunderbar.
Ich erhalte je nachdem welcher Excel-Version verwendet wird, in diesem Code einen Fehler:
           

Code:

If .Range("G" & Zeile).Value And .Range("I" & Zeile).Value <> "" Then
            .Range("K" & Zeile).Interior.ColorIndex = arrMatrix(.Range("G" & Zeile).Value, .Range("I" & Zeile).Value)

In Excel 2010 funktioniert der Code wunderbar, in einer älteren version leider nicht (Citrix-Anwendung)
Es kommt vor, dass in G und/ oder I eine leere Zelle vorhanden ist. Vielleicht ist dies in meinem Code nicht ausreichend genug definiert.
Habt ihr eine Idee? Oder vielleicht sogar einen alternativen/ eleganteren Vorschlag, dass Ziel zu erreichen?
Mit Select-Case kriegt man das nicht hin, richtig? So wie ich das verstanden habe, ist Select-Case nur dafür gedacht, wenn nur 1 Wert untersucht wird. Hier werden ja zwei Werte/ Spalten untersucht.

Code:

Sub Colour()

Dim arrMatrix(1 To 5, 1 To 5) As String
Dim ZeileMax As Byte
Dim Zeile As Byte
   
   arrMatrix(1, 1) = 4
   arrMatrix(3, 1) = 4
   
   arrMatrix(1, 4) = 6
   arrMatrix(5, 1) = 6
   
   arrMatrix(5, 2) = 3
   arrMatrix(4, 5) = 3
   
   With tblOne
   
   ZeileMax = Sheets("tblOne").Cells(.Rows.Count, "B").End(xlUp).Row
   
        For Zeile = 2 To ZeileMax
       
           If .Range("G" & Zeile).Value And .Range("I" & Zeile).Value <> "" Then
           .Range("K" & Zeile).Interior.ColorIndex = arrMatrix(.Range("G" & Zeile).Value, .Range("I" & Zeile).Value)
           End If
       
        Next Zeile

   End With

End Sub

Gesamter Code

[Ego]

Hallo joshua,

versuchs mal mit:

Code:

If .Range("G" & Zeile).Value <> "" And .Range("I" & Zeile).Value <> "" Then

[Kuwer]

Hallo joshua,

1. ist der Makroname Color ein reserviertes Schlüsselwort
2. die Matrix wird als String deklariert, obwohl Zahlen erwartet werden
3. die Zeilenvariablen werden als Byte deklariert? Sind es denn immer weniger als 257 Zeilen?
4. es wird nur Spalte I auf "" geprüft
5. Deine Beispieldatei passt nicht zum Code (anderer Tabellenname).
6. Deine Beispielkombinationen sind nicht in der Matrix hinterlegt.

Das wäre mein Vorschlag:

Sub ColourCells()

 Dim arrMatrix(1 To 5, 1 To 5) As Long

 Dim ZeileMax As Long

 Dim Zeile As Long

 

 arrMatrix(1, 1) = 4

 arrMatrix(3, 1) = 4

 

 arrMatrix(1, 4) = 6

 arrMatrix(5, 1) = 6

 

 arrMatrix(5, 2) = 3

 arrMatrix(4, 5) = 3

 

 With Sheets("tblSummary")

   ZeileMax = .Cells(.Rows.Count, 2).End(xlUp).Row

   For Zeile = 2 To ZeileMax

     If Len(.Cells(Zeile, 7).Value) And Len(.Cells(Zeile, 9).Value) Then

       .Cells(Zeile, 11).Interior.ColorIndex = arrMatrix(.Cells(Zeile, 7).Value, .Cells(Zeile, 9).Value)

     End If

   Next Zeile

 End With

End Sub

Gruß Uwe

[joshua]

Hallo ego und Kuwer,

bei beiden Ansätzen erhalten ich in der folgenden Zeile einen Fehler:

Code:

           .Cells(Zeile, 11).Interior.ColorIndex = arrMatrix(.Cells(Zeile, 7).Value, .Cells(Zeile, 9).Value)

Unter Office 2010 läuft alles super, unter einer Citrix-Anwendung mit einer älteren office-Version erhalte ich leider einen Error.
Vielleicht liegt es dadran, dass leere Zellen enthalten sind.
Sollte hierfür vielleicht ein array entsprechend definiert werden?

Wie sieht es mit einer Select-Case Anweisung aus?

@Kuwert: Bei der Bereitstellung der Musterdatei habe ich wohl nicht sorfälltig genug gearbeitet.

[Kuwer]

Hallo,

Vielleicht liegt es dadran, dass leere Zellen enthalten sind.

nein, daran liegt es nicht, weil das ja vorab überprüft wird.
Und Punkt 6 hast Du beachtet und entsprechend ergänzt?

Lass mal folgendes Makro laufen und schau, was die Msgbox zeigt (die kommt, wenn sonst ein Fehler wäre).

Sub TestColourCells()

  Dim arrMatrix(1 To 5, 1 To 5) As Long

  Dim ZeileMax As Long

  Dim Zeile As Long

  

  arrMatrix(1, 1) = 4

  arrMatrix(3, 1) = 4

  

  arrMatrix(1, 4) = 6

  arrMatrix(5, 1) = 6

  

  arrMatrix(5, 2) = 3

  arrMatrix(4, 5) = 3

  

  On Error Resume Next

  

  With Sheets("tblSummary")

    ZeileMax = .Cells(.Rows.Count, 2).End(xlUp).Row

    For Zeile = 2 To ZeileMax

      If Len(.Cells(Zeile, 7).Value) And Len(.Cells(Zeile, 9).Value) Then

        .Cells(Zeile, 11).Interior.ColorIndex = arrMatrix(.Cells(Zeile, 7).Value, .Cells(Zeile, 9).Value)

        If Err.Number > 0 Then

          MsgBox "<" & arrMatrix(.Cells(Zeile, 7).Value, .Cells(Zeile, 9).Value) & ">"

          Err.Clear

        End If

      End If

    Next Zeile

  End With

End Sub

Gruß Uwe

[joshua]

Hallo Uwe,

ich hatte einen kleiner Fehler gemacht.
Nun funkioniert alles super (:

Bzgl. Punkt 6: Für jede Kombination gibt es auch ein array (:
Habe diese nur bei der Mustertabelle nicht komplett übernommen. Entschuldige dafür!