Range zu lang, zu viele Zellen?

[RPP63]

Dann mach es halt per Doppelklick!
Die Logik sollte doch jetzt nachvollziehbar sein?

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim z&, s&, n&, m&
With Target
  For z = 5 To 123 Step 2
    For n = 0 To 1
      For m = 0 To 2
        s = n * 14 + m * 3 + 2
        If .Address = Me.Cells(z, s).Address Then
          .Value = IIf(Len(.Value), "", "X")
          Cancel = True
          Exit For
        End If
      Next
    Next
  Next
  If Not Intersect(Target, Range("M4:M123, AA4:AA123")) Is Nothing Then
    .Value = IIf(Len(.Value), "", "X")
    Cancel = True
  End If
End With
End Sub

Gruß Ralf

[Elex]

Gib den Zellen eine andere Eigenschaft mit der sie sich von den anderen unterscheiden (z.B.Farbe) und frage diese Eigenschaft ab und nicht locked.

[barthi]

Es klappt einwandfrei RPP66. 
Es wird allerdings kompliziert, wenn man zwei verschiedene Anweisungen per Doppelklick auf einem Blatt einbinden will. 
Die Idee mit der Hintergrundfarbe ist einfach genial
Der Colorcode muss da mit in das Intersect oben oder?

[Elex]

Hi barthi!

Antwort auf PN.
 
Ralf machte in #6 einen guten Vorschlag. Umsetzung klappte bei dir irgendwie nicht wegen Konflikten zu anderen Zellen. Also lieferte Ralf dir in #11 eine weitere Möglichkeit.
Mein Vorschlag mit der Farbe bezog sich wieder auf #6. Du könntest den Zellen auch andere Eigenschaften geben und diese Abfragen. Hauptsache sie unterscheiden sich dadurch von allen anderen. (Schriftgröße; Fett; oder...) 

Code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Interior.Color <> vbRed Then Exit Sub
Target = IIf(Len(Target.Cells), "", "X")
Cancel = True
End Sub

Mfg Elex

[barthi]

Code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)


If Target.Interior.Color <> RGB(251, 251, 251) Then Exit Sub


Target = IIf(Len(Target.Cells), "", "X")


Cancel = True


End Sub




Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)


If Target.Interior.Color <> RGB(251, 251, 251) Then Exit Sub


If Target = Len(Target.Cells) Then
   frmCalendar.Show
   ActiveCell.Value = g_datCalendarDate
 
Else
Target.Cells(1) = vbNullString
End If


Cancel = True


End Sub

Vielen Dank. Das klappt wunderbar. 
Habe nach dem schema jetzt 2 Subs, die auch funktionieren. Möchte ich nun beide auf einem Blatt funktioniert es nicht, da beide die Doppelklickanweisung haben. Kann ich die jetzt zb mit case zusammenführen?

[Elex]

Versuch es mal so.

Änder für die eine Gruppe von Zellen die Farbe etwas.

Code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Target.Interior.Color = RGB(251, 251, 251) Then Target = IIf(Len(Target.Cells), "", "X")

If Target.Interior.Color <> RGB(251, 251, 250) Then Exit Sub
If Target = Len(Target.Cells) Then
   frmCalendar.Show
   ActiveCell.Value = g_datCalendarDate
Else
Target.Cells(1) = vbNullString
End If

Cancel = True

End Sub