Office 2010: Zellen Sperren Datentool

[Toby_F]

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

[Officer]

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

[Toby_F]

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?

[Officer]

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

[Toby_F]

sorry dass ich nerve, aber irgendwie bekomme die VBA nicht auf die folgende Datei umgemünzt.....
Kann mir hier jmd evtl. helfen 

[Officer]

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