1. Liebe Forumsgemeinde,

    aufgrund der Bestimmungen, die sich aus der DSGVO ergeben, müssten umfangreiche Anpassungen am Forum vorgenommen werden, die sich für uns nicht wirtschaftlich abbilden lassen. Daher haben wir uns entschlossen, das Forum in seiner aktuellen Form zu archivieren und online bereit zu stellen, jedoch keine Neuanmeldungen oder neuen Kommentare mehr zuzulassen. So ist sichergestellt, dass das gesammelte Wissen nicht verloren geht, und wir die Seite dennoch DSGVO-konform zur Verfügung stellen können.
    Dies wird in den nächsten Tagen umgesetzt.

    Ich danke allen, die sich in den letzten Jahren für Hilfesuchende und auch für das Forum selbst engagiert haben. Ich bin weiterhin für euch erreichbar unter tti(bei)pcwelt.de.
    Dismiss Notice

Zellfarbe kurz ändern

Discussion in 'Office-Programme' started by MZurmuehlen, Oct 20, 2007.

Thread Status:
Not open for further replies.
  1. Hascheff

    Hascheff Moderator

    Die beißt sich auch nicht mit dem Befehl.
    In Spalte D wirkt die bedingte Formatierung nur in leeren Zellen und die willst du ja nicht in Orange leuchten lassen.

    Damit ist auch der Ausweg klar. Du musst in Spalte G Bedingung 2 der bed. F. löschen und diese Formatierung zum Standard machen.
     
  2. ok hab verstanden thx
     
  3. ich hab jetzt mal ein bisschen umgestaltet und hab schon wieder ein problem nach "msgbox ' 2' " hört er auf zu arbeiten
    als anlage ein kleiner ausschnitt wie die tabelle jetzt aussieht

    hier der code:
    Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    'If pruef = 1 Then Exit Sub
    Dim strName As String
    Dim raZelle As Range
    'MsgBox " 1"
    On Error GoTo ersatz
    'MsgBox " 2"
    If Target <> 7 Then Exit Sub
    'MsgBox " 3"
    strName = Target.Offset(0, -4)
    'MsgBox " 4"
    Range("C3:G24").Select
    Range("G3").Activate
    Selection.Sort Key1:=Range("G3"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal
    Range("K3:N18").Select
    Range("N3").Activate
    Selection.Sort Key1:=Range("N3"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal
    Range("S3:V12").Select
    Range("V3").Activate
    Selection.Sort Key1:=Range("V3"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal
    Range("A1").Select
    'MsgBox " 5"
    Select Case Cells.Range("f4:f24")
    Case Is > 0
    Cells.Range("f4:f24").Interior.ColorIndex = 1
    Cells.Range("f4:f24").Font.ColorIndex = 2
    Case Else
    Cells.Range("f4:f24").Interior.ColorIndex = 2
    Cells.Range("f4:f24").Font.ColorIndex = 2
    End Select
    'MsgBox " 6"
    Set raZelle = Range("C3:C24").Find(strName, lookat:=xlWhole)
    If raZelle.Offset(0, 4) = Application.Min(Range("G3:G24")) Then
    Cells(raZelle.Row, "D").Interior.ColorIndex = 10
    Cells(raZelle.Row, "D").Font.ColorIndex = 2
    Application.Wait (Now + TimeValue("0:00:03"))
    MsgBox " 7a"
    Cells(raZelle.Row, "D").Interior.ColorIndex = 1
    Cells(raZelle.Row, "D").Font.ColorIndex = 2
    Else
    Cells(raZelle.Row, "D").Interior.ColorIndex = 46
    Cells(raZelle.Row, "D").Font.ColorIndex = 1
    Cells(raZelle.Row, "F").Interior.ColorIndex = 46
    Cells(raZelle.Row, "F").Font.ColorIndex = 1
    Application.Wait (Now + TimeValue("0:00:03"))
    MsgBox " 7b"
    Cells(raZelle.Row, "D").Interior.ColorIndex = 1
    Cells(raZelle.Row, "D").Font.ColorIndex = 2
    Cells(raZelle.Row, "F").Interior.ColorIndex = 1
    Cells(raZelle.Row, "F").Font.ColorIndex = 2
    End If
    ansonsten sollte der code korrekt sein denke ich mal
     

    Attached Files:

  4. Beverly

    Beverly Halbes Megabyte

    Hi,

    ich habe dir mehrfach deinen Code angepasst, sodass er ohne Select und Activate auskommt, da in VBA zu 99,9% auf diese Befehle verzichtet werden kann. Offensichtlich bist du da anderer Meinung. Ich möchte dir da aber auf keinen Fall reinreden - aus diesem Grund ist der Thread für mich abgeschlossen.
     
  5. ich hab den letzten fehler jetzt noch selber rausgekriegt.
    trotzdem danke für eure hilfe
    als anlage hab ich nochmal meine persönliche lösung hochgeladen (für diejenigen die ein ähnliches problem haben) ihr müsst nur wieder das ".txt" dahinter löschen
     

    Attached Files:

Thread Status:
Not open for further replies.

Share This Page