Variable Select Case-Funktion

Forumthread: Variable Select Case-Funktion

Stefan

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

AW: Variable Select Case-Funktion

20.01.2011 18:58:03

Rudi

Hallo,
hab das jetzt nicht ausgepackt.
.Cells(.Rows.Count, 6).End(xlUp).Row - 7 ergibt eine Zahl (die Zeile -7) nicht wie zuvor einen String (sf)
vermutlich eher so:
Case .Cells(.Rows.Count, 6).End(xlUp).Offset(-7)
Gruß
Rudi

AW: Variable Select Case-Funktion

20.01.2011 21:37:47

Stefan

Hallo Rudi
Vielen Dank für deinen Tipp. Mit "Offset" funktioniert der Code leider auch nicht. In meinem Code war noch ein kleiner Fehler: Der Zellenbezug muss anstatt .Cells(.Rows.Count, 6).End(xlUp).Row - 2 bis .Cells(.Rows.Count, 6).End(xlUp).Row - 7 mit .Cells(.Rows.Count, 6).End(xlUp).Row - 5 bis .Cells(.Rows.Count, 6).End(xlUp).Row sein (siehe Anhang). Auch diese Korrektur hat nichts gebracht. Anscheinend ist diese Prozedur nicht so einfach zum Umsetzten.
Ich hoffe es kann mir sonst noch jemand helfen.
Gruss
Stefan
Anhang: https://www.herber.de/bbs/user/73170.zip

ziemlich viel Case...

20.01.2011 21:52:40

Christian

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

AW: ziemlich viel Case...

21.01.2011 09:12:26

Stefan

Hallo Christian
Vielen Dank für die rasche Hilfe. Ich dachte mir, das der Code auch auf eine einfachere Art umzusetzen ist, wie du es mir in deinem interessanten Beispiel beschrieben hast. Ich habe die Liste gemäss deinen Anweisungen angepasst und die beiden Module integriert (siehe Anhang). Leider passiert da noch gar nichts! Irgend etwas habe ich falsch gemacht. Ich wäre froh, wenn du die angepasste Datei gelegetlich mal überprüfen könntest, um herauszufinden was da falsch ist. Ich glaube ansonsten entspricht dein Vorschlag genau meinen Vorstellungen.
Vielen Dank.
Gruss
Stefan
Anhang. https://www.herber.de/bbs/user/73173.zip

nicht in ein neues Klassenmodul...

21.01.2011 09:59:16

Christian

sondern in das Modul "Tabelle1 (Pendenzen)". Das ist das Klassenmodul der Tabelle.
Also im Projekt-Explorer auf "Tabelle1 (Pendenzen)" klicken und dort den ersten Teil des Codes rein kopieren.
Das allg. Modul für die Funktion passt so.
Gruß
Christian

AW: nicht in ein neues Klassenmodul...

21.01.2011 11:02:57

Stefan

Hallo Christian
Tip top, die Prozedur läuft nun fehlerfrei! Trotzdem habe ich noch eine kleine Ergänzung:
Beim alten Code wurden in Spalte F nur diejenigen Kürzel als Fettschrift formatiert, welche in der Gültigkeitsliste hinterlegt sind. Alle zusätzlichen Kürzel (Personen, welche nicht in unserer Firma angestellt sind wie Lieferanten und Unternehmer), also welche nicht in der Gültigkeitsliste erfasst werden, sollten in Schmalschrift schwarz formatiert werden. Gibt es hier eine Möglichkeit, den Code entsprechend zu erweitern?
Gruss
Stefan

ja, das geht auch ...

21.01.2011 19:12:27

Christian

... dann musst du auch den Schrifttyp Fett oder Standard bei den Namenskürzel "Personen" formatieren, Stefan.
Und die Funktion muss dann ein Array zurück geben mit Schriftfarbe und Typ.
zB. so:

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

und im allg. Modul:

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

Gruß
Christian

AW: ja, das geht auch ...

24.01.2011 15:46:37

Stefan

Hallo Christian
Super, jetzt funktioniert alles gemäss meinen Vorstellungen. Vielen Dank für deine speditive Hilfe.
Auch das mit dem Bezug auf den Bereich "Personen" ist die flexiblere Lösung.
Gruss
Stefan

Beliebteste Forumthreads (12 Monate)

Forumthread: Variable Select Case-Funktion

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Variable Select Case-Funktion

Forumthread: Variable Select Case-Funktion

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

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread