Moin Philipp,
ich habe den Code extra übersichtlich gehalten, auf ein paar mehr oder weniger eilen sollte es da nicht ankommen. Bei sehr viel mehr Auswertungen wirst du den Code nach If Not Pruef Is Nothing Then
vielleicht etwas verschlanken, aber copy/paste geht ja auch gaz fix ...
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)
Dim rngZ9 As Range, rngZ13 As Range, rngAmpel As Range, c As Range
Dim Pruef As Range
Set rngZ9 = Range("F9:H9")
Set rngZ13 = Range("F13:H13")
Set rngAmpel = Application.Union(rngZ9, rngZ13)
Set Pruef = Intersect(Target, rngAmpel)
If Not Pruef Is Nothing Then
If Not Intersect(Target, rngZ9) Is Nothing Then
For Each c In rngZ9
c = ""
Next c
Target = "x"
Else
For Each c In rngZ13
c = ""
Next c
Target = "x"
End If
Cancel = True
End If
End Sub
Ich habe es geprüft und es haut hin.