Office: (Office 2016) In den Zellen G6 bis I6 darf nur ein x gemacht sein!

Wenn es nicht so hochsicherheitsmäßig funktionieren muss, sondern die Optionsfeld-Funktion ausreicht, dann

Code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   Dim a(2): a(1) = "C6:F29": a(2) = "G6:I29"
   For i = 1 To 2
      If Not Intersect(Target, Range(a(i))) Is Nothing Then
         Range(Replace(Replace(a(i), 29, 6), 6, Target.Row)).ClearContents
         Target = "X"
         Cancel = True
      End If
   Next
End Sub

 

Ist auch Super...Da hier keine Fehlermeldung kommt
und meine Kollegen wirklich nur ein auswählen können!!

Dankeschön für die Hilfe

Grüße Weismänn

 

Die "Fehlermeldung" bei meinem Code ist doch keine "Fehler"meldung - die MsgBox kannst du doch auch weglassen...

Bis später,
Karin

 

Karin...

das stimmt natürlich... :-)


lupo1, es funktioniert nun fast alles wie ich es möchte,

bis auf das ich wenn ich ein "X" in das Feld mit der Maus geklickt hab, muss ich wenn ich es entfernen Will

mit der Tastatur löschen...kann das auch so umstellen das es auch mit der Maus zu entfernen ist?

Danke euch für eure super Hilfe...

Grüße Weismänn

 

ungetestet mit Rechtsklick

Code:

Private Sub Worksheet_BeforeRightClick(ByVal T As Range, C As Boolean)
    If Not Intersect(T, Range("C6:I29")) Is Nothing Then T.ClearContents: C = True
End Sub

 

Mir scheint, du hast meinen Code überhaupt nicht gestestet: da musst du nämlich nichts von Hand löschen - das funktioniert doch automatisch, sobald du in einer Zelle mit einem X doppelklickst...

Bis später,
Karin

 

Danke ...

Ich habe es getestet und es funktioniert...

Grüße Weismänn

 

Hallo Karina,

sicher habe ich deine Programierung getestet...und da kann ich alles mit der Maus machen...

Grüße Weismänn

 

Hallo...
nun habe ich noch einen Auswahlbereich mehr G5:H96 soll auch nur ein X möglich sein,
ich habe schon versucht die Programierung zu Ändern...aber meine Kenntnisse reichen einfach nicht aus.
Könnt mir jemand nochmal Helfen...

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim a(2): a(1) = "C5:D96": a(2) = "E5:F96"
For i = 1 To 2
If Not Intersect(Target, Range(a(i))) Is Nothing Then
Range(Replace(Replace(a(i), 96, 5), 5, Target.Row)).ClearContents
Target = "X"
Cancel = True
End If
Next
End Sub

Grüße Weismänn

 

Private Sub Worksheet_BeforeDoubleClick(ByVal T As Range, C As Boolean)
Dim a(3): a(1) = "C5:D96": a(2) = "E5:F96": a(3) = "G5:H96"
For i = 1 To 3
If Not Intersect(T, Range(a(i))) Is Nothing Then
Range(Replace(Replace(a(i), 96, 5), 5, T.Row)).ClearContents
T = "X"
C = True
End If
Next
End Sub

oder auch

Code:

Private Sub Worksheet_BeforeRightClick(ByVal T As Range, C As Boolean)
  a = "A5:B96"
  For i = 1 To 3
   a = Range(a).Offset(0, 2).Address
   If Not Intersect(T, Range(a)) Is Nothing Then
    Range(Replace(Replace(a, 96, 5), 5, T.Row)).ClearContents
    T = "X"
    C = True
   End If
  Next
End Sub

... mit dem Vorteil, dass das Anhängen von I5:J96 nun nur noch eine einzige Änderung benötigt: 4 statt 3

 

lupo1

Vielen Dank...funktioniert Super :-)

Grüße Weismänn