Microsoft Office Forum [ www.Office-Fragen.de ] >> READONLY <<

Microsoft Office 2003-2019 => Excel => Thema gestartet von: Toby_F am Juli 16, 2014, 15:04:40 Nachmittag

Titel: Office 2010: Zellen Sperren Datentool
Beitrag von: Toby_F am Juli 16, 2014, 15:04:40 Nachmittag
Wäre es möglich, dass man zb. die Anzahl der maximalen "x" in einer bestimmten Zelle individuell anpassen kann und dass sich diese Bedingung dann auf die maximale Eingabe bezieht?
Beispiel in A1 gebe ich im Auswahlfeld max 5 an und somit können in der Tabelle max 5 x gesetzt werden. Erhöhe oder verringere ich den Wert auf 8 dürfen max 8 Felder ange"x"t werden.
Vielen Dank schon mal für die Bemühungen
Titel: Antw:Office 2010: Zellen Sperren Datentool
Beitrag von: Officer am Juli 16, 2014, 15:15:20 Nachmittag
Hallo Toby_F,

ich hab mal schnell folgende kleine Prozedur gebastelt.

Code: Visual Basic
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2. lngcnt = 0
  3.  
  4. If Application.Intersect(Target, Range("A3:A4")) Is Nothing Then
  5.   For a = 3 To 14
  6.     If Cells(a, 1).Value = "x" Then
  7.       lngcnt = lngcnt + 1
  8.     End If
  9.   Next a
  10.  
  11.   If lngcnt > 4 Then
  12.     Target.Value = ""
  13.   End If
  14.  
  15. End If
  16. End Sub
  17.  

Sobald ein 5´tes "x" eingegeben wird, wird dieses autoamtisch wieder gelöscht.

Die Lösung habe ich auch noch mal als Anlage beigefügt.

Gruß Alois


Titel: Antw:Office 2010: Zellen Sperren Datentool
Beitrag von: Toby_F am Juli 16, 2014, 15:36:01 Nachmittag
Hmmm ich habe glaube ich vergessen zu sagen, dass ich in b 1 die maximalen "X"e vorgeben möchte, die in B1 vorgegebenen "x"e sollen dann die Eingabe gemäß der Vorgabe in b1 beschränken.
Wie geht das?
Titel: Antw:Office 2010: Zellen Sperren Datentool
Beitrag von: Officer am Juli 16, 2014, 15:40:04 Nachmittag
Hallo,

dann wird einfach nicht auf >4 geprüft sondern auf den Inhalt der Zelle B1.
Hier der leicht geänderte Code

Code: Visual Basic
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2.  
  3. lngcnt = 0
  4.  
  5. If Application.Intersect(Target, Range("A3:A4")) Is Nothing Then
  6.  
  7.   For a = 3 To 14
  8.     If Cells(a, 1).Value = "x" Then
  9.       lngcnt = lngcnt + 1
  10.     End If
  11.   Next a
  12.  
  13.   If lngcnt > Range("B1").Value Then
  14.     Target.Value = ""
  15.   End If
  16.  
  17. End If
  18.  
  19. End Su
  20.  

Gruß Alois
Titel: Antw:Office 2010: Zellen Sperren Datentool
Beitrag von: Toby_F am Juli 16, 2014, 20:06:48 Nachmittag
sorry dass ich nerve, aber irgendwie bekomme die VBA nicht auf die folgende Datei umgemünzt.....
Kann mir hier jmd evtl. helfen  :-[
Titel: Antw:Office 2010: Zellen Sperren Datentool
Beitrag von: Officer am Juli 21, 2014, 07:29:44 Vormittag
Hallo TobyF,

hier der geänderte VBA-Code speziell für Deine Datei.

Code: Visual Basic
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2.  
  3. lngcnt = 0
  4.  
  5. If Not Application.Intersect(Target, Range("G7:G18")) Is Nothing Then
  6.  
  7.   For a = 7 To 18
  8.     If Cells(a, 7).Value = "x" Then
  9.       lngcnt = lngcnt + 1
  10.     End If
  11.   Next a
  12.  
  13.   If lngcnt > Range("F2").Value Then
  14.     Target.Value = ""
  15.   End If
  16.  
  17. End If
  18.  
  19. End Sub
  20.  

Als Anlage habe ich auch noch deine Testdatei beigefügt, die nun funktioniert.

Gruß Alois