Thema Datum  Von Nutzer Rating
Antwort
09.05.2018 08:42:36 V.B.A.
NotSolved
09.05.2018 10:34:26 V.B.A.
NotSolved
09.05.2018 10:48:23 Werner
NotSolved
09.05.2018 10:54:04 Gast50769
NotSolved
Rot Einzelne Einträge in Zelle prüfen und auf bestimmtes Format setzen
09.05.2018 11:59:35 Werner
NotSolved
09.05.2018 12:10:58 V.B.A.
NotSolved
09.05.2018 14:17:40 Werner
NotSolved
09.05.2018 14:44:23 V.B.A.
Solved

Ansicht des Beitrags:
Von:
Werner
Datum:
09.05.2018 11:59:35
Views:
579
Rating: Antwort:
  Ja
Thema:
Einzelne Einträge in Zelle prüfen und auf bestimmtes Format setzen

Hallo,

warum benutzt du dafür nicht das Doppelklick-Event des Tabellenblattes?

Code gehört ins Codemodul des Tabellenblattes auf dem er sich auswriken soll.

-Rechtsklick auf den Tabellenblattreiter - Code anzeigen - Code rechts ins Codefenster kopieren

 

Bei Doppelklick in Spalte A bis F wird die Schriftfarbe der doppelt angeklickten Zelle gewechselt wenn:

-die doppelt angeklickte Zelle nicht leer ist und wenn eine Zahl in der Zelle steht

-wenn in der gleichen Zeile in Spalte G ein x gesetzt ist

 

Bei Doppelklick in Spalte H wird die Schriftfarbe der doppelt angeklickten Zelle und der zwei fogenden Zellen gewechselt wenn:

-die dippelt angeklickte Zelle nicht leer ist und wenn eine Zahl in der Zelle steht

-wenn in der gleichen Zeile in Spalte G ein x gesetzt ist

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Unprotect Password:=""
Cancel = True
If Target.Column <= 6 Then
    If Not IsEmpty(Target.Value) Then
        If IsNumeric(Target.Value) Then
            If UCase(Cells(Target.Row, 7).Value) = "X" Then
                If Target.Font.ColorIndex <> 16 Then
                    Target.Font.ColorIndex = 16
                ElseIf Target.Font.ColorIndex = 16 Then
                    Target.Font.ColorIndex = xlAutomatic
                End If
            Else
                MsgBox "Bitte die Zeile markieren."
            End If
        End If
    End If
ElseIf Target.Column = 8 Then
    If Not IsEmpty(Target.Value) Then
        If IsNumeric(Target.Value) Then
            If UCase(Cells(Target.Row, 7).Value) = "X" Then
                If Target.Font.ColorIndex <> 16 Then
                    Target.Resize(1, 3).Font.ColorIndex = 16
                ElseIf Target.Font.ColorIndex = 16 Then
                    Target.Resize(1, 3).Font.ColorIndex = xlAutomatic
                End If
            Else
                MsgBox "Bitte die Zeile markieren."
            End If
        End If
    End If
End If
Protect Password:=""
End Sub

Gruß Werner


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
09.05.2018 08:42:36 V.B.A.
NotSolved
09.05.2018 10:34:26 V.B.A.
NotSolved
09.05.2018 10:48:23 Werner
NotSolved
09.05.2018 10:54:04 Gast50769
NotSolved
Rot Einzelne Einträge in Zelle prüfen und auf bestimmtes Format setzen
09.05.2018 11:59:35 Werner
NotSolved
09.05.2018 12:10:58 V.B.A.
NotSolved
09.05.2018 14:17:40 Werner
NotSolved
09.05.2018 14:44:23 V.B.A.
Solved