Bedingte Formatierung und VBA

  • Excel

Es gibt 34 Antworten in diesem Thema. Der letzte Beitrag () ist von Sam85.

    @VaporiZed

    ja ich verstehe was du meinst, seltsam das es dennoch irgendwie funktioniert. Dann werde ich wohl auf die andere Option zurückgreifen. Vermutlich muss ich dann mit einer Worksheetfunction arbeiten. Das schaue ich mir dann morgen mal an. Danke für deine Unterstützung. :)

    So nun hab ich zwar die Worksheetfunction aber weiß gar nicht, wie ich damit den Farbbefehl übergeben kann. ?(


    VB.NET-Quellcode

    1. Option Explicit
    2. Dim az As Worksheet, rowEnd As Long, colEnd As Long, zeit As Range, therapeut As Range, tzeit As Range
    3. Dim wks As Worksheet, wsf As WorksheetFunction, cntCol As Long, cntRow As Long
    4. Dim startTime As Range, startTherapeut As Range, startPunkt As Range
    6. Sub ColorTime()
    8. Set az = ThisWorkbook.Worksheets("Arbeitszeit")
    9. rowEnd = az.Cells(Rows.Count, 1).End(xlUp).Row
    10. colEnd = az.Cells(1, Columns.Count).End(xlToLeft).Column
    11. zeit = az.Range(az.Cells(2, 1), az.Cells(rowEnd, 1))
    12. therapeut = az.Range(az.Cells(1, 2), az.Cells(1, colEnd))
    13. tzeit = az.Range(az.Cells(2, 2), Cells(rowEnd, colEnd))
    15. Set wks = ThisWorkbook.ActiveSheet
    16. cntRow = wks.Cells(Rows.Count, 1).End(xlUp).Row
    17. cntCol = wks.Cells(5, Columns.Count).End(xlToLeft).Column
    18. startTime = wks.Cells(6, 1)
    19. startTherapeut = wks.Cells(5, 2)
    20. startPunkt = wks.Cells(6, 2)
    22. Set wsf = Application.WorksheetFunction
    23. wsf.Index(tzeit, wsf.Match(wsf.Round(startTime, 4), wsf.Round(zeit, 4), wsf.Match(startTherapeut, therapeut, 0))) = 0
    25. With wks.Range(startPunkt, wks.Cells(cntRow, cntCol))
    26. ' .Interior.ColorIndex = 1
    27. End With
    28. End Sub

    @VaporiZed
    Bin mir nicht sicher aber kann ich irgendwie das x auch auf das hier anwenden also statt Formula1 Formulax?

    Quellcode

    1. Formula1:="=NICHT(ISTFEHLER(SUCHEN(" & name & ";B6;1)))"


    VB.NET-Quellcode

    1. Sub ColorPatient()
    2. Set pat = ThisWorkbook.Worksheets("Patient")
    3. colPat = pat.Cells(1, Columns.Count).End(xlToLeft).Column
    5. Set wks = ThisWorkbook.ActiveSheet
    6. cntCol = wks.Cells(5, Columns.Count).End(xlToLeft).Column
    7. cntRow = wks.Cells(Rows.Count, 1).End(xlUp).Row
    9. On Error GoTo weiter
    11. For x = 2 To colPat - 1
    12. colName = pat.Cells(x, 2)
    13. name = """" & colName & """"
    14. colColor = pat.Cells(x, 3)
    15. With wks.Range(wks.Cells(6, 2), wks.Cells(cntRow, cntCol))
    16. .FormatConditions.Add Type:=xlExpression, Formula1:="=NICHT(ISTFEHLER(SUCHEN(" & name & ";B6;1)))"
    17. .FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    18. With .FormatConditions(x - 1).Interior
    19. .PatternColorIndex = colColor
    20. .ThemeColor = xlThemeColorLight1
    21. .TintAndShade = 0.14996795556505
    22. End With
    23. .FormatConditions(x - 1).StopIfTrue = False
    24. End With
    25. Next x
    26. Exit Sub
    28. weiter:
    29. MsgBox ("Ausserhalb der Reichweite. Bitte im Kalenderbereich auswählen!")
    30. End Sub

    Um was zu erreichen? Dass Du mehrere Regeln für eine Zelle hast und dann damit klarmachen willst, in welcher Reihenfolge die Regeln angewandt werden?
    Dieser Beitrag wurde bereits 5 mal editiert, zuletzt von „VaporiZed“, mal wieder aus Grammatikgründen.

    Aufgrund spontaner Selbsteintrübung sind all meine Glaskugeln beim Hersteller. Lasst mich daher bitte nicht den Spekulatiusbackmodus wechseln.

    Kurzer Blick in das MSDN => Du kannst für eine gesetzte Formel konkret die Priorität festlegen oder Du erstellst die Formeln nacheinander und rufst dann entweder immer SetFirstPriority (wie Du es bei Post#17 in Zeile 23 tatest => dann wird später die Ausführreihenfolge, wenn Du 3 Formeln hinterlegst: Formel3, dann Formel2, dann Formel1) oder SetLastPriority auf (=> dann wird später die Ausführreihenfolge: Formel1, dann Formel2, dann Formel3).
    Dieser Beitrag wurde bereits 5 mal editiert, zuletzt von „VaporiZed“, mal wieder aus Grammatikgründen.

    Aufgrund spontaner Selbsteintrübung sind all meine Glaskugeln beim Hersteller. Lasst mich daher bitte nicht den Spekulatiusbackmodus wechseln.

    Wie baue ich denn den Code um, damit für jeden Namen der Code einmal eingetragen wird?

    Spoiler anzeigen

    VB.NET-Quellcode

    1. Sub ColorPatient()
    2. Set pat = ThisWorkbook.Worksheets("Patient")
    3. colPat = pat.Cells(1, Columns.Count).End(xlToLeft).Column
    5. Set wks = ThisWorkbook.ActiveSheet
    6. cntCol = wks.Cells(5, Columns.Count).End(xlToLeft).Column
    7. cntRow = wks.Cells(Rows.Count, 1).End(xlUp).Row
    9. On Error GoTo weiter
    11. For x = 2 To colPat - 1
    12. colName = pat.Cells(x, 2)
    13. name = """" & colName & """"
    14. colColor = pat.Cells(x, 3)
    15. With wks.Range(wks.Cells(6, 2), wks.Cells(cntRow, cntCol))
    16. .FormatConditions.Add Type:=xlExpression, Formula1:="=NICHT(ISTFEHLER(SUCHEN(" & name & ";B6;1)))"
    17. ' .FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    18. With .FormatConditions(x).Interior
    19. .PatternColorIndex = colColor
    20. .ThemeColor = xlThemeColorLight1
    21. .TintAndShade = 0.14996795556505
    22. End With
    23. .FormatConditions(x).StopIfTrue = False
    24. End With
    25. Next x
    26. Exit Sub
    28. weiter:
    29. MsgBox ("Ausserhalb der Reichweite. Bitte im Kalenderbereich auswählen!")
    30. End Sub

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „Sam85“ ()

    Und wieder einmal: Ist es gewollt, dass der Patientenname nur in der Zelle B6 gesucht wird?
    OK, solange ich das Problem (»Hinterlege eine individuelle, zelladressrelative Formatierungsformel, indem man nur eine Range angibt, also ohne jede einzelne Zelle anzusprechen.«) nicht lösen kann, werd ich mich wohl nicht mehr lösungsorientiert äußern können.
    Dieser Beitrag wurde bereits 5 mal editiert, zuletzt von „VaporiZed“, mal wieder aus Grammatikgründen.

    Aufgrund spontaner Selbsteintrübung sind all meine Glaskugeln beim Hersteller. Lasst mich daher bitte nicht den Spekulatiusbackmodus wechseln.

    Ich kann auch nur diesmal sagen, dass die bedingte Formatierung automatisch immer weiter such (siehe Bild) und mir (bisher halt nur anhand der einen Formel) den ersten Namen überall markiert wo er vorkommt (dasselbe Phänomen wie in der anderen Formel).

    Mein anliegen ist lediglich, kann ich die bedingte Formatierung (unabhängig davon ob die Formel logisch korrekt ist) anhand einer For Funktion kopieren?

    tippscout.de/excel-bedingte-fo…chichtplan_tipp_5671.html hier wird ebenfalls die Funktion so verwendet wie ich sie nutze nur das nicht erklärt wird, wieso es so geht.

    Ich denke, die bedingte Formatierung ist intelligent konzipiert und such automatisch weiter?! Weiß sonst jemand etwas dazu?
    Bilder

    • Bild.PNG

      41,68 kB, 1.381×438, 150 mal angesehen

    Also ich bin jetzt zumindest soweit, dass alle Formeln eingetragen werden nur die Farbkondition wird nicht eingehalten. ?( Wohin muss ich das verschieben?

    Quellcode

    1. .FormatConditions(x).Interior.ColorIndex = colColor


    VB.NET-Quellcode

    1. Sub ColorPatient()
    2. Set pat = ThisWorkbook.Worksheets("Patient")
    3. colPat = pat.Cells(1, Columns.Count).End(xlToLeft).Column
    4. rowPat = pat.Cells(Rows.Count, 2).End(xlUp).Row
    6. Set zellbereich = pat.Range(pat.Cells(2, 2), pat.Cells(rowPat, 2))
    8. Set wks = ThisWorkbook.ActiveSheet
    9. cntCol = wks.Cells(5, Columns.Count).End(xlToLeft).Column
    10. cntRow = wks.Cells(Rows.Count, 1).End(xlUp).Row
    12. On Error GoTo weiter
    14. For x = 2 To colPat - 1
    15. For Each zelle In zellbereich
    16. Name = """" & zelle & """"
    17. colColor = pat.Cells(x, 3)
    18. With wks.Range(wks.Cells(6, 2), wks.Cells(cntRow, cntCol))
    19. .FormatConditions.Add Type:=xlExpression, Formula1:="=NICHT(ISTFEHLER(SUCHEN(" & Name & ";B6;1)))"
    20. .FormatConditions(x).Interior.ColorIndex = colColor
    21. .FormatConditions(x).StopIfTrue = False
    22. End With
    23. Next zelle
    24. Next x
    25. Exit Sub
    27. weiter:
    28. MsgBox ("Ausserhalb der Reichweite. Bitte im Kalenderbereich auswählen!")
    29. End Sub

    Auch wieder interessant, dass das bei Dir funktioniert, da .FormatConditions(x) ja laut Schleife bei 2 anfängt. Bei mir wird sofort ein Fehler erzeugt, da es nach dem 1. Formelanlegen nur eine Formel gibt, und zwar .FormatConditions(1). Zum anderen: Hast Du in Spalte 3 der Patiententabelle Farbindizes von 0-55 (oder 1-56) eingetragen?
    Dieser Beitrag wurde bereits 5 mal editiert, zuletzt von „VaporiZed“, mal wieder aus Grammatikgründen.

    Aufgrund spontaner Selbsteintrübung sind all meine Glaskugeln beim Hersteller. Lasst mich daher bitte nicht den Spekulatiusbackmodus wechseln.

    Ja warum es geht ist mir auch schleierhaft, es geht sogar automatisch (also sobald ich den Button klicke verteilt sich die Farbe).
    Ja die Condition 1 ist die andere Funktion mit der Arbeitszeit bzw. den Zeiten wo kein Termin belegt werden kann (unterer Code). Die Sub ist für die Einfärbung der Patienten (oberer Code).
    Also im Moment hab ich nur 3 oder 4 mit Farbe angelegt der Rest ist einfach nichts (war erstmal zum Testen)..ansonsten würde ich von 1 bis 56 gemäß diesem Link nehmen. :)

    Spoiler anzeigen

    VB.NET-Quellcode

    1. Option Explicit
    2. Dim wks As Worksheet, pat As Worksheet, cntCol As Long, cntRow As Long, colPat As Long, rowPat As Long
    3. Dim x As Integer, y As Integer, colName As String, colColor As String, Name As String
    4. Dim zeit As Worksheet, cntTimeRow As Long, cntTimeCol As Long
    5. Dim zellbereich As Range, zelle As Range
    7. Sub ColorClear()
    8. Set wks = ThisWorkbook.ActiveSheet
    9. cntCol = wks.Cells(5, Columns.Count).End(xlToLeft).Column
    10. cntRow = wks.Cells(Rows.Count, 1).End(xlUp).Row
    12. With wks.Range(wks.Cells(6, 2), wks.Cells(cntRow, cntCol))
    13. .FormatConditions.Delete
    14. End With
    15. End Sub
    17. Sub ColorPatient()
    18. Set pat = ThisWorkbook.Worksheets("Patient")
    19. colPat = pat.Cells(1, Columns.Count).End(xlToLeft).Column
    20. rowPat = pat.Cells(Rows.Count, 2).End(xlUp).Row
    22. Set zellbereich = pat.Range(pat.Cells(2, 2), pat.Cells(rowPat, 2))
    24. Set wks = ThisWorkbook.ActiveSheet
    25. cntCol = wks.Cells(5, Columns.Count).End(xlToLeft).Column
    26. cntRow = wks.Cells(Rows.Count, 1).End(xlUp).Row
    28. On Error GoTo weiter
    30. For x = 2 To colPat - 1
    31. For Each zelle In zellbereich
    32. Name = """" & zelle & """"
    33. colColor = pat.Cells(x, 3)
    34. With wks.Range(wks.Cells(6, 2), wks.Cells(cntRow, cntCol))
    35. .FormatConditions.Add Type:=xlExpression, Formula1:="=NICHT(ISTFEHLER(SUCHEN(" & Name & ";B6;1)))"
    36. .FormatConditions(x).Interior.ColorIndex = colColor
    37. .FormatConditions(x).StopIfTrue = False
    38. End With
    39. Next zelle
    40. Next x
    41. Exit Sub
    43. weiter:
    44. MsgBox ("Ausserhalb der Reichweite. Bitte im Kalenderbereich auswählen!")
    45. End Sub



    Spoiler anzeigen

    VB.NET-Quellcode

    1. Sub ColorTime()
    2. Set zeit = ThisWorkbook.Worksheets("Arbeitszeit")
    3. cntTimeCol = zeit.Cells(1, Columns.Count).End(xlToLeft).Column
    4. cntTimeRow = zeit.Cells(Rows.Count, 1).End(xlUp).Row
    6. x = cntTimeCol
    7. y = cntTimeRow
    8. Name = HoleSpaltenname(x)
    10. Set wks = ThisWorkbook.ActiveSheet
    11. cntCol = wks.Cells(5, Columns.Count).End(xlToLeft).Column
    12. cntRow = wks.Cells(Rows.Count, 1).End(xlUp).Row
    14. On Error GoTo weiter
    16. With wks.Range(wks.Cells(6, 2), wks.Cells(cntRow, cntCol))
    17. .FormatConditions.Add Type:=xlExpression, Formula1:="=INDEX(Arbeitszeit!$B$2:$" & Name & "$" & y & ";VERGLEICH(RUNDEN($A6;4);RUNDEN(Arbeitszeit!$A$2:$A$" & y & ";4);0);VERGLEICH(B$5;Arbeitszeit!$B$1:$" & Name & "$1;0))=0"
    18. '.FormatConditions.Add Type:=xlExpression, Formula1:="=INDEX(Arbeitszeit!$B$2:$F$26;VERGLEICH(RUNDEN($A6;4);RUNDEN(Arbeitszeit!$A$2:$A$26;4);0);VERGLEICH(B$5;Arbeitszeit!$B$1:$F$1;0))=0"
    19. .FormatConditions(1).Interior.ColorIndex = 1
    20. .FormatConditions(1).StopIfTrue = False
    21. End With
    22. Exit Sub
    24. weiter:
    25. MsgBox ("Ausserhalb der Reichweite. Bitte im Kalenderbereich auswählen!")
    26. End Sub
    28. Function HoleSpaltenname(Index As Integer) As String
    29. Dim dividend As Integer, modulo As Integer, Name As String
    30. dividend = Index
    32. Do While (dividend > 0)
    33. modulo = (dividend - 1) Mod 26
    34. Name = Chr(65 + modulo) & Name
    35. dividend = (dividend - modulo) / 26
    36. Loop
    38. HoleSpaltenname = Name
    39. End Function




    Dieser Beitrag wurde bereits 4 mal editiert, zuletzt von „Sam85“ ()

    Hab mal was gelerntes angewendet :) so funktioniert es.

    VB.NET-Quellcode

    1. Sub ColorPatient()
    2. Set pat = ThisWorkbook.Worksheets("Patient")
    3. colPat = pat.Cells(1, Columns.Count).End(xlToLeft).Column
    4. rowPat = pat.Cells(Rows.Count, 2).End(xlUp).Row
    6. Set zellbereich = pat.Range(pat.Cells(2, 2), pat.Cells(rowPat, 2))
    8. Set wks = ThisWorkbook.ActiveSheet
    9. cntCol = wks.Cells(5, Columns.Count).End(xlToLeft).Column
    10. cntRow = wks.Cells(Rows.Count, 1).End(xlUp).Row
    12. On Error GoTo weiter
    14. x = 1
    16. For Each zelle In zellbereich
    17. x = x + 1
    18. Name = """" & zelle & """"
    19. colColor = pat.Cells(x, 3)
    20. With wks.Range(wks.Cells(6, 2), wks.Cells(cntRow, cntCol))
    21. .FormatConditions.Add Type:=xlExpression, Formula1:="=NICHT(ISTFEHLER(SUCHEN(" & Name & ";B6;1)))"
    22. .FormatConditions(x).Interior.ColorIndex = colColor
    23. .FormatConditions(x).StopIfTrue = False
    24. End With
    25. Next zelle
    26. Exit Sub
    28. weiter:
    29. MsgBox ("Ausserhalb der Reichweite. Bitte im Kalenderbereich auswählen!")
    30. End Sub

    Hab da nochmal eine Frage. Wollte ein Worksheetfunction Ergebnis in eine For Each Schleife einbauen. Wie muss ich da die Deklarationen setzen, damit es funktioniert? (Wenn das überhaupt so geht :)).

    Spoiler anzeigen

    VB.NET-Quellcode

    1. Sub BorderColor()
    2. Dim wsf As WorksheetFunction, jump As Integer, jumps As Integer
    4. Set wks = ThisWorkbook.ActiveSheet
    5. cntCol = wks.Cells(5, Columns.Count).End(xlToLeft).Column
    6. cntRow = wks.Cells(Rows.Count, 1).End(xlUp).Row
    8. Set thr = ThisWorkbook.Worksheets("Therapeut")
    9. cntRowT = thr.Cells(Rows.Count, 2).End(xlUp).Row
    11. Set wsf = Application.WorksheetFunction
    12. jumps = wsf.CountA(wks.Range(wks.Cells(2, 2), wks.Cells(2, cntCol)))
    14. x = 6
    15. y = 2
    17. For Each jump In jumps
    18. With wks.Range(wks.Cells(x, y), wks.Cells(cntRow, cntRowT))
    19. .Borders(xlDiagonalDown).LineStyle = xlNone
    20. .Borders(xlDiagonalUp).LineStyle = xlNone
    21. .Borders(xlEdgeLeft).LineStyle = xlContinuous
    22. .Borders(xlEdgeRight).LineStyle = xlContinuous
    23. .Borders(xlEdgeTop).LineStyle = xlContinuous
    24. .Borders(xlEdgeBottom).LineStyle = xlContinuous
    25. End With
    26. x = x + cntRowT
    27. y = y + cntRowT
    28. Next jump


    EDIT: Hab es so gelöst.

    VB.NET-Quellcode

    1. Sub ColorBorder()
    3. Set wks = ThisWorkbook.ActiveSheet
    4. cntCol = wks.Cells(5, Columns.Count).End(xlToLeft).Column
    5. cntRow = wks.Cells(Rows.Count, 1).End(xlUp).Row
    7. Set thr = ThisWorkbook.Worksheets("Therapeut")
    8. cntRowT = thr.Cells(Rows.Count, 2).End(xlUp).Row
    10. Set wsf = Application.WorksheetFunction
    11. jump = wsf.CountA(wks.Range(wks.Cells(2, 2), wks.Cells(2, cntCol)))
    13. y = 2
    14. z = 6
    16. For i = 1 To jump
    17. With wks.Range(wks.Cells(6, y), wks.Cells(cntRow, z))
    18. .BorderAround Weight:=xlMedium, ColorIndex:=3
    19. End With
    20. y = y + cntRowT - 1
    21. z = z + cntRowT - 1
    22. Next i
    24. End Sub

    Dieser Beitrag wurde bereits 2 mal editiert, zuletzt von „Sam85“ ()

    bzgl. der Mysteriums warum die bedingte Formatierung erst ausgeführt wenn das Workbook geschlossen wird und die bedingte Formatierung bestätigt wird bin ich jetzt hier aktiv
    office-loesung.de/p/viewtopic.…739647&p=3072447#p3072447

Facebook
Telefonspende