Bedingte Formatierung und VBA

  • Excel

SSL ist deaktiviert! Aktivieren Sie SSL für diese Sitzung, um eine sichere Verbindung herzustellen.

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
    5. Sub ColorTime()
    6. Set az = ThisWorkbook.Worksheets("Arbeitszeit")
    7. rowEnd = az.Cells(Rows.Count, 1).End(xlUp).Row
    8. colEnd = az.Cells(1, Columns.Count).End(xlToLeft).Column
    9. zeit = az.Range(az.Cells(2, 1), az.Cells(rowEnd, 1))
    10. therapeut = az.Range(az.Cells(1, 2), az.Cells(1, colEnd))
    11. tzeit = az.Range(az.Cells(2, 2), Cells(rowEnd, colEnd))
    12. Set wks = ThisWorkbook.ActiveSheet
    13. cntRow = wks.Cells(Rows.Count, 1).End(xlUp).Row
    14. cntCol = wks.Cells(5, Columns.Count).End(xlToLeft).Column
    15. startTime = wks.Cells(6, 1)
    16. startTherapeut = wks.Cells(5, 2)
    17. startPunkt = wks.Cells(6, 2)
    18. Set wsf = Application.WorksheetFunction
    19. wsf.Index(tzeit, wsf.Match(wsf.Round(startTime, 4), wsf.Round(zeit, 4), wsf.Match(startTherapeut, therapeut, 0))) = 0
    20. With wks.Range(startPunkt, wks.Cells(cntRow, cntCol))
    21. ' .Interior.ColorIndex = 1
    22. End With
    23. 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
    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
    7. On Error GoTo weiter
    8. For x = 2 To colPat - 1
    9. colName = pat.Cells(x, 2)
    10. name = """" & colName & """"
    11. colColor = pat.Cells(x, 3)
    12. With wks.Range(wks.Cells(6, 2), wks.Cells(cntRow, cntCol))
    13. .FormatConditions.Add Type:=xlExpression, Formula1:="=NICHT(ISTFEHLER(SUCHEN(" & name & ";B6;1)))"
    14. .FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    15. With .FormatConditions(x - 1).Interior
    16. .PatternColorIndex = colColor
    17. .ThemeColor = xlThemeColorLight1
    18. .TintAndShade = 0.14996795556505
    19. End With
    20. .FormatConditions(x - 1).StopIfTrue = False
    21. End With
    22. Next x
    23. Exit Sub
    24. weiter:
    25. MsgBox ("Ausserhalb der Reichweite. Bitte im Kalenderbereich auswählen!")
    26. 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.

    ― Eine häufig von mir verwendete Abkürzung: CEs = control elements (Labels, Buttons, DGVs, ...)
    ― If Not GrammarIsOk() Then AssumeThatCodeIsOk = False
    ― »Oh, großes Spaghetticodemonster. Bitte schicke mir Durchblick! Oder zumindest eine Gabel. Oder – wenn es kein Besteck mehr gibt – zumindest Glasnudeln.«
    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.

    ― Eine häufig von mir verwendete Abkürzung: CEs = control elements (Labels, Buttons, DGVs, ...)
    ― If Not GrammarIsOk() Then AssumeThatCodeIsOk = False
    ― »Oh, großes Spaghetticodemonster. Bitte schicke mir Durchblick! Oder zumindest eine Gabel. Oder – wenn es kein Besteck mehr gibt – zumindest Glasnudeln.«
    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
    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
    7. On Error GoTo weiter
    8. For x = 2 To colPat - 1
    9. colName = pat.Cells(x, 2)
    10. name = """" & colName & """"
    11. colColor = pat.Cells(x, 3)
    12. With wks.Range(wks.Cells(6, 2), wks.Cells(cntRow, cntCol))
    13. .FormatConditions.Add Type:=xlExpression, Formula1:="=NICHT(ISTFEHLER(SUCHEN(" & name & ";B6;1)))"
    14. ' .FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    15. With .FormatConditions(x).Interior
    16. .PatternColorIndex = colColor
    17. .ThemeColor = xlThemeColorLight1
    18. .TintAndShade = 0.14996795556505
    19. End With
    20. .FormatConditions(x).StopIfTrue = False
    21. End With
    22. Next x
    23. Exit Sub
    24. weiter:
    25. MsgBox ("Ausserhalb der Reichweite. Bitte im Kalenderbereich auswählen!")
    26. 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.

    ― Eine häufig von mir verwendete Abkürzung: CEs = control elements (Labels, Buttons, DGVs, ...)
    ― If Not GrammarIsOk() Then AssumeThatCodeIsOk = False
    ― »Oh, großes Spaghetticodemonster. Bitte schicke mir Durchblick! Oder zumindest eine Gabel. Oder – wenn es kein Besteck mehr gibt – zumindest Glasnudeln.«
    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, 20 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
    5. Set zellbereich = pat.Range(pat.Cells(2, 2), pat.Cells(rowPat, 2))
    6. Set wks = ThisWorkbook.ActiveSheet
    7. cntCol = wks.Cells(5, Columns.Count).End(xlToLeft).Column
    8. cntRow = wks.Cells(Rows.Count, 1).End(xlUp).Row
    9. On Error GoTo weiter
    10. For x = 2 To colPat - 1
    11. For Each zelle In zellbereich
    12. Name = """" & zelle & """"
    13. colColor = pat.Cells(x, 3)
    14. With wks.Range(wks.Cells(6, 2), wks.Cells(cntRow, cntCol))
    15. .FormatConditions.Add Type:=xlExpression, Formula1:="=NICHT(ISTFEHLER(SUCHEN(" & Name & ";B6;1)))"
    16. .FormatConditions(x).Interior.ColorIndex = colColor
    17. .FormatConditions(x).StopIfTrue = False
    18. End With
    19. Next zelle
    20. Next x
    21. Exit Sub
    22. weiter:
    23. MsgBox ("Ausserhalb der Reichweite. Bitte im Kalenderbereich auswählen!")
    24. 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.

    ― Eine häufig von mir verwendete Abkürzung: CEs = control elements (Labels, Buttons, DGVs, ...)
    ― If Not GrammarIsOk() Then AssumeThatCodeIsOk = False
    ― »Oh, großes Spaghetticodemonster. Bitte schicke mir Durchblick! Oder zumindest eine Gabel. Oder – wenn es kein Besteck mehr gibt – zumindest Glasnudeln.«
    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
    6. Sub ColorClear()
    7. Set wks = ThisWorkbook.ActiveSheet
    8. cntCol = wks.Cells(5, Columns.Count).End(xlToLeft).Column
    9. cntRow = wks.Cells(Rows.Count, 1).End(xlUp).Row
    10. With wks.Range(wks.Cells(6, 2), wks.Cells(cntRow, cntCol))
    11. .FormatConditions.Delete
    12. End With
    13. End Sub
    14. Sub ColorPatient()
    15. Set pat = ThisWorkbook.Worksheets("Patient")
    16. colPat = pat.Cells(1, Columns.Count).End(xlToLeft).Column
    17. rowPat = pat.Cells(Rows.Count, 2).End(xlUp).Row
    18. Set zellbereich = pat.Range(pat.Cells(2, 2), pat.Cells(rowPat, 2))
    19. Set wks = ThisWorkbook.ActiveSheet
    20. cntCol = wks.Cells(5, Columns.Count).End(xlToLeft).Column
    21. cntRow = wks.Cells(Rows.Count, 1).End(xlUp).Row
    22. On Error GoTo weiter
    23. For x = 2 To colPat - 1
    24. For Each zelle In zellbereich
    25. Name = """" & zelle & """"
    26. colColor = pat.Cells(x, 3)
    27. With wks.Range(wks.Cells(6, 2), wks.Cells(cntRow, cntCol))
    28. .FormatConditions.Add Type:=xlExpression, Formula1:="=NICHT(ISTFEHLER(SUCHEN(" & Name & ";B6;1)))"
    29. .FormatConditions(x).Interior.ColorIndex = colColor
    30. .FormatConditions(x).StopIfTrue = False
    31. End With
    32. Next zelle
    33. Next x
    34. Exit Sub
    35. weiter:
    36. MsgBox ("Ausserhalb der Reichweite. Bitte im Kalenderbereich auswählen!")
    37. 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
    5. x = cntTimeCol
    6. y = cntTimeRow
    7. Name = HoleSpaltenname(x)
    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
    11. On Error GoTo weiter
    12. With wks.Range(wks.Cells(6, 2), wks.Cells(cntRow, cntCol))
    13. .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"
    14. '.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"
    15. .FormatConditions(1).Interior.ColorIndex = 1
    16. .FormatConditions(1).StopIfTrue = False
    17. End With
    18. Exit Sub
    19. weiter:
    20. MsgBox ("Ausserhalb der Reichweite. Bitte im Kalenderbereich auswählen!")
    21. End Sub
    22. Function HoleSpaltenname(Index As Integer) As String
    23. Dim dividend As Integer, modulo As Integer, Name As String
    24. dividend = Index
    25. Do While (dividend > 0)
    26. modulo = (dividend - 1) Mod 26
    27. Name = Chr(65 + modulo) & Name
    28. dividend = (dividend - modulo) / 26
    29. Loop
    30. HoleSpaltenname = Name
    31. 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
    5. Set zellbereich = pat.Range(pat.Cells(2, 2), pat.Cells(rowPat, 2))
    6. Set wks = ThisWorkbook.ActiveSheet
    7. cntCol = wks.Cells(5, Columns.Count).End(xlToLeft).Column
    8. cntRow = wks.Cells(Rows.Count, 1).End(xlUp).Row
    9. On Error GoTo weiter
    10. x = 1
    11. For Each zelle In zellbereich
    12. x = x + 1
    13. Name = """" & zelle & """"
    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(x).Interior.ColorIndex = colColor
    18. .FormatConditions(x).StopIfTrue = False
    19. End With
    20. Next zelle
    21. Exit Sub
    22. weiter:
    23. MsgBox ("Ausserhalb der Reichweite. Bitte im Kalenderbereich auswählen!")
    24. 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
    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
    6. Set thr = ThisWorkbook.Worksheets("Therapeut")
    7. cntRowT = thr.Cells(Rows.Count, 2).End(xlUp).Row
    8. Set wsf = Application.WorksheetFunction
    9. jumps = wsf.CountA(wks.Range(wks.Cells(2, 2), wks.Cells(2, cntCol)))
    10. x = 6
    11. y = 2
    12. For Each jump In jumps
    13. With wks.Range(wks.Cells(x, y), wks.Cells(cntRow, cntRowT))
    14. .Borders(xlDiagonalDown).LineStyle = xlNone
    15. .Borders(xlDiagonalUp).LineStyle = xlNone
    16. .Borders(xlEdgeLeft).LineStyle = xlContinuous
    17. .Borders(xlEdgeRight).LineStyle = xlContinuous
    18. .Borders(xlEdgeTop).LineStyle = xlContinuous
    19. .Borders(xlEdgeBottom).LineStyle = xlContinuous
    20. End With
    21. x = x + cntRowT
    22. y = y + cntRowT
    23. Next jump


    EDIT: Hab es so gelöst.

    VB.NET-Quellcode

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