Variable Select Case-Funktion

Hallo zusammen
Auch in diesem Jahr hoffe ich auf eure Unterstützung:
In einer vorhandenen Pendenzenliste habe ich bedingte Formatierungen mit Select Case eingerichtet, welche einwandfrei funktionieren. Dabei können in Abhängigkeit der Personenauswahl und Status 6 verschiedene Farben, Schriftart fett und normal ausgewählt werden (Siehe Anhang, Pendenzenliste1).
Da ich aber mehrere dieser Listen mit unterschiedlichen Personen pflegen muss, will ich die Select Case-Prozedur flexibler gestalten, in dem ich das mögliche Ergebnis nicht mit dem Befehl "Case "sf" vorgebe, sondern mit einem Case-Bezug auf eine bestimmte Zelle verweisen will. Dies habe ich mit dem "Case Is = .Cells(.Rows.Count, 6).End(xlUp).Row - 7" versucht (Siehe Anhang, Pendenzenliste1). Leider hatte ich mit dieser Code-Änderung keinen Erfolg und weiss jetzt auch nicht weiter, wie ich den Code auf mein neues Bedürfnis anpassen kann oder dies überhaupt möglich ist.
Ich wäre froh, wenn mir jemand weiterhelfen könnte.
Gruss
Stefan
Anhang: https://www.herber.de/bbs/user/73164.zip

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Stefan,
was nebem dem vielen Case sonst noch auffällt:
- pack den Code in das "Worksheet_Change" Ereignis des betreffenden Tabellenblatts. Es macht ja keinen Sinn, den Code in jedem Tabellenblatt der Datei zu starten.
- prüfe ganz am Anfang die betreffenden Spalten und Zeilen. Wenn außerhalb des relevanten Bereichs, dann Exit.
Mein Vorschlag zu deiner Frage:
- Setze die Schriftfarbe der jeweiligen Namen in der Tabelle "Gültigkeit" (zB. rot für "sf", grün für "Be", etc.)
- suche den Namen in der Tabelle "Gültigkeit" (in meinem Bsp mit VERGLEICH)
- wann immer der Eintrag in Spalte B leer ist und in Spalte J kein "e" steht, ordnest du der Zelle in Spalte F diese Schriftfarbe zu.
Lösche deinen Code (oder kommentiere diesen komplett aus) für folgendes Beispiel.
Achja, und lösche die Legende, mein Beispiel läuft bis zur letzten Zeile in Spalte A.
Im Klassenmodul der Tabelle "Pendenzen":

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row  Cells(Rows.Count, 1).End(xlUp).Row Then Exit Sub
If IsError(Application.Match(Target.Column, Array(1, 2, 6, 10), 0)) Then Exit Sub
Dim rngR As Range
Dim lngR As Long
lngR = Target.Row
Set rngR = Cells(lngR, 1).Resize(, 11)
With rngR.Font
Select Case Target.Column
Case 1
.Bold = (Right(Cells(lngR, 1), 2) = "00")
Case 2
If Cells(lngR, 10)  "e" Then
Select Case Cells(lngR, 2)
Case "I", "E": .ColorIndex = 23
Case "P":      .ColorIndex = 3
Case Else
.ColorIndex = 1
Cells(lngR, 6).Font.ColorIndex = udfGetColor(Cells(lngR, 6).Text, 4)
End Select
End If
Case 6
If Cells(lngR, 10)  "e" And Cells(lngR, 2) = "" Then
Cells(lngR, 6).Font.ColorIndex = udfGetColor(Cells(lngR, 6).Text, 4)
End If
Case 10
If Cells(lngR, 10) = "e" Then
.ColorIndex = 16
Else
Cells(lngR, 6) = Cells(lngR, 6)
Cells(lngR, 2) = Cells(lngR, 2)
End If
End Select
End With
Set rngR = Nothing
End Sub

in ein allgemeines Modul (im VB-Editor "einfügen - Modul")

Option Explicit
Function udfGetColor(strName As String, lngFR As Long) As Long
Dim i As Long, lngLR As Long
Dim vntMtch
With ThisWorkbook.Sheets("Gültigkeit")
lngLR = .Cells(.Rows.Count, 3).End(xlUp).Row
vntMtch = Application.Match(strName, .Cells(lngFR, 3).Resize(lngLR - lngFR + 1), 0)
If Not IsError(vntMtch) Then
udfGetColor = .Cells(vntMtch + lngFR - 1, 3).Font.ColorIndex
Else
udfGetColor = 1
End If
End With
End Function

Gruß
Christian

Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row Cells(Rows.Count, 1).End(xlUp).Row Then Exit Sub If IsError(Application.Match(Target.Column, Array(1, 2, 6, 10), 0)) Then Exit Sub Dim lngR As Long Dim vntFormat lngR = Target.Row With Cells(lngR, 1).Resize(, 11).Font Select Case Target.Column Case 1 .Bold = (Right(Cells(lngR, 1), 2) = "00") Case 2 If Cells(lngR, 10) "e" Then Select Case Cells(lngR, 2) Case "I", "E": .ColorIndex = 23 Case "P": .ColorIndex = 3 Case Else .ColorIndex = 1 vntFormat = udfGetFormat(Cells(lngR, 6).Text) Cells(lngR, 6).Font.ColorIndex = vntFormat(0) Cells(lngR, 6).Font.Bold = vntFormat(1) End Select End If Case 6 vntFormat = udfGetFormat(Cells(lngR, 6).Text) If Cells(lngR, 10) "e" And Cells(lngR, 2) = "" Then Cells(lngR, 6).Font.ColorIndex = vntFormat(0) End If Cells(lngR, 6).Font.Bold = vntFormat(1) Case 10 If Cells(lngR, 10) = "e" Then .ColorIndex = 16 Else Cells(lngR, 6) = Cells(lngR, 6) Cells(lngR, 2) = Cells(lngR, 2) End If End Select End With End Sub

Option Explicit Function udfGetFormat(strName As String) Dim vntMtch, vntRes(1) Dim rngPers As Range Set rngPers = Range("Personen") vntMtch = Application.Match(strName, rngPers, 0) If Not IsError(vntMtch) Then vntRes(0) = rngPers.Cells(vntMtch, 1).Font.ColorIndex vntRes(1) = rngPers.Cells(vntMtch, 1).Font.Bold Else vntRes(0) = 1 vntRes(1) = False End If udfGetFormat = vntRes Set rngPers = Nothing End Function

Beliebteste Forumthreads (12 Monate)

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread