Excel: Zellen Sperren bei Eingabe einer gewissen Zahl

Dieses Thema Excel: Zellen Sperren bei Eingabe einer gewissen Zahl im Forum "Microsoft Office Suite" wurde erstellt von Arne2007, 28. Nov. 2007.

Thema: Excel: Zellen Sperren bei Eingabe einer gewissen Zahl Hallo Excelprofis :), in den folgenden Zellen (D4:D15) kann man die Werte 1-5 eingeben. Sollte eine 1 eingegeben...

  1. Hallo Excelprofis :),

    in den folgenden Zellen (D4:D15) kann man die Werte 1-5 eingeben. Sollte eine 1 eingegeben werden, sollen die anderen Zellen gesperrt und rot eingefärbt werden. Habt Ihr einen Vorschlag für ein Makro?

    Vielen Dank für eure Hilfe im voraus,

    Arne
     
  2. Makro ist nicht unbedingt nötig, geht auch mit den bedingten Formatierungen aus Menü Format. Da kannst du Bedingungen und Bezüge kombinieren.
     
  3. Hi,

    danke für deine Antwort, aber bei der bedingeten formatierung finde ich den Punkt Zelle sperren nicht. Hab ich was übersehen?

    --Arne
     
  4. ups ... das sperren hab ich übersehen. ist das unbedingt notwendig? knallrote zellen sind doch schon abschreckend genug ::)

    sorry für die halbgare antwort

    EXPERTEN VOR!!!!!!!!!!!!!
     
  5. kein problem :), aber das sperren muss leider sein.
     
  6. Hi zusammen,

    der folgende Code sollte in der Code-Seite des Tabellenblattes zu liegen kommen. (Blattlasche markieren -> Code anzeigen)

    Gruß Matjes :)
    Code:
    Option Explicit
    
    Private Sub Worksheet_Change(ByVal Target As Range)
     
     Const sRANGE = D4:D15
     
     Dim r As Range, Zelle As Range
     
    ->Schnittmenge
     Set r = Application.Intersect(Range(sRANGE), Target)
     If r Is Nothing Then GoTo AUFRAEUMEN
     
    ->Im Bereich eine 1 suchen
     Set r = Range(sRANGE)
     For Each Zelle In r
      If CStr(Zelle.Value) = 1 Then Exit For
     Next
    ->Blattsperre aufheben
     r.Parent.Unprotect
     r.Locked = False
    ->wurde eine 1 gefunden ?
     If Not Zelle Is Nothing Then
     ->Zellen ohne 1 gesperrt setzen und Rot einfärben
      For Each Zelle In r
       Zelle.Interior.ColorIndex = xlColorIndexNone
       If CStr(Zelle.Value) <> 1 Then
        Zelle.Interior.ColorIndex = 3
        Zelle.Locked = True
       End If
      Next
     Else
     ->alle Zellen farblos setzen
      For Each Zelle In r
       Zelle.Interior.ColorIndex = xlColorIndexNone
      Next
     End If
    ->Blattsperre setzen
     r.Parent.Protect
     
    AUFRAEUMEN:
     Set r = Nothing: Set Zelle = Nothing
    End Sub
     
  7. Guten morgen Matjes,

    der Code funktioniert einwandfrei :). Vielen Dank.
    Nun sind nur leider DropDown-Felder definiert, sodass man die Zahl zwar nicht in die Zelle eingeben kann, aber per DropDown schon. Wenn Du dazu eine Idee hast, wäre ich dankbar, sonst müssen die DropDown Felder eben weg.


    Viele Grüße,

    Arne


    LÖSUNG: In der Gültigkeit ZellenDropDown deaktivieren, dann hat man die Abfrage, ob die eingegeben Zahl stimmt, aber nicht das DropDown-Feld selber.
     
  8. Hallo zusammen,
    noch eine Frage zu dem Code....
    Wenn ich den Code auf mehrere Spalten anwenden möchte z.B. D14:d15 und F14:F15, wie muss ich dort verfahren?

    Vielen Dank,

    Arne
     
  9. Hallo Arne2007,

    der Code muß etwas erweitert werden.

    Gruß Matjes :)
    Code:
    Option Explicit
    
    Private Sub Worksheet_Change(ByVal Target As Range)
     
     Dim r As Range, Zelle As Range
     Dim v As Variant
     v = Array(D4:D15, F4:F15)
     Dim x As Long
     Dim bFound As Boolean
     
     
    ->Schnittmenge vorhanden ?
     bFound = False
     For x = 0 To UBound(v)
      Set r = Application.Intersect(Range(v(x)), Target)
      If Not r Is Nothing Then bFound = True: Exit For
     Next
     If r Is Nothing Then GoTo AUFRAEUMEN
     
    ->Im Bereich eine 1 suchen
     bFound = False
     For x = 0 To UBound(v)
      Set r = Range(v(x))
      For Each Zelle In r
       If CStr(Zelle.Value) = 1 Then bFound = True: Exit For
      Next
      If bFound Then Exit For
     Next
     
    ->Blattsperre aufheben
     r.Parent.Unprotect
     r.Locked = False
     
     For x = 0 To UBound(v)
      Set r = Range(v(x))
     ->wurde eine 1 gefunden ?
      If bFound Then
      ->Zellen ohne 1 gesperrt setzen und Rot einfärben
       For Each Zelle In r
        Zelle.Interior.ColorIndex = xlColorIndexNone
        If CStr(Zelle.Value) <> 1 Then
         Zelle.Interior.ColorIndex = 3
         Zelle.Locked = True
        End If
       Next
      Else
      ->alle Zellen farblos setzen
       For Each Zelle In r
        Zelle.Interior.ColorIndex = xlColorIndexNone
       Next
      End If
     Next
     
    ->Blattsperre setzen
     r.Parent.Protect
     
    AUFRAEUMEN:
     Set r = Nothing: Set Zelle = Nothing
    End Sub
     
  10. Hallo,

    leider hab ich mich etwas falsch ausgedrückt.. :( sry dafür!
    Die Spalten D4:D15,F4:F15 und H4:H15 müssen unabhängig voneinander den code ausführen.
    Es wäre sehr nett, wenn Du mir nochmal helfen könntest.
    Grundsätzlich müssten die Arrays immer unabhängig voneinader betrachtet werden. Sehr schön wäre es, wenn man dann noch weitere Arrays definieren könnte, sodass man die Tabelle noch um mehrere Felder (Arrays) erweitern kann.

    Vielen Dank und Grüße,

    Arne
     
Die Seite wird geladen...

Excel: Zellen Sperren bei Eingabe einer gewissen Zahl - Ähnliche Themen

Forum Datum
Zellen in Excel ziehen Ergänzung des vorhandenen Makors Microsoft Office Suite 10. Juli 2011
Excel 2003 Kann man bestimmte Zellen im Listenbereich schützen? Microsoft Office Suite 24. Feb. 2011
Excel: Summe beliebiger Anzahl Zellen (also nicht die Werte) ? Microsoft Office Suite 2. Dez. 2010
Excel: Zellen verbinden Windows XP Forum 25. Juni 2010
Excel - Anfänger - Zelle soll nur durch best. Anzahl der Zellen teilen Windows XP Forum 5. Feb. 2010