Zellbereich durch 'X' auswählen

[diving_excel]

Hallo!

Im Bereich B7:B9 kann durch Doppelklick ein "X" gesetzt werden. Jedes mal wenn ein "X" gesetzt wird, soll die jeweilige Zeile markiert werden (z.B. C7:H7). Funktioniert soweit gut, nur wenn ich eine weitere Zeile markieren möchte, wird die erste Auswahl aufgehoben. 

Anbei mein Code bisher:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)

'BLOCK 1:
If Worksheets("Tabelle1").Range("B7") = "X" Then
  Worksheets("Tabelle1").Range("C7:H7").Select
End If

'BLOCK 2:
If Worksheets("Tabelle1").Range("B8") = "X" Then
  Worksheets("Tabelle1").Range("C8:H8").Select
End If

'BLOCK 3:
If Worksheets("Tabelle1").Range("B9") = "X" Then
  Worksheets("Tabelle1").Range("C9:H9").Select
End If

End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   
   If Not Intersect(Target, Range("B7:B9")) Is Nothing Then
       Target = IIf(Target = "", "X", "")
       Cancel = True
   End If
   
   If Target.Cells.Count <> 1 Then Exit Sub
   If Intersect(Target, Range("E7:G9")) Is Nothing Then Exit Sub
   Intersect(Target.EntireRow, Range("E7:G9")).ClearContents
   Target.Value = "X"


End Sub

Ist es möglich den Bereich zu erweitern? So dass bei jedem "X" der entsprechende Bereich zusätzlich markiert wird?
Bzw. dass wenn bei Abwahl des 'X' der jeweilige Bereich wieder abgewählt wird?



Danke und Gruß!

[Elex]

Hi

Code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim rng As Range, Zelle As Variant

  If Not Intersect(Target, Range("B7:B9")) Is Nothing Then
      Target = IIf(Target = "", "X", "")
      For Each Zelle In Range("B7:B9")
         If Zelle.Value = "X" Then
            If rng Is Nothing Then
              Set rng = Zelle.Offset(, 1).Resize(, 6)
            Else
              Set rng = Application.Union(rng, Zelle.Offset(, 1).Resize(, 6))
            End If
         End If
      Next Zelle
     
   If Not rng Is Nothing Then rng.Select
   Cancel = True
  End If
End Sub

Gruß Elex

[mmat]

Hallo,

ich hab das jetzt zusammengenagelt, also poste ich es auch, obwohl Elex schneller war

Code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim zeile As Long, spalte As Long, s As String
  If Target.Cells.Count <> 1 Then Exit Sub
  If Intersect(Target, Range("B7:B9")) Is Nothing Then Exit Sub
   
  Target = IIf(Target = "", "X", "")
  Cancel = True
 
  spalte = 2
  For zeile = 7 To 9
    If Cells(zeile, spalte) = "X" Then
      If s <> "" Then s = s + ","
      s = s + "C" & CStr(zeile) & ":H" & CStr(zeile)
    End If
  Next
  Range(s).Select
End Sub

[diving_excel]

Danke, elex seine Lösung hat funktioniert, aber deine probier ich auch mal aus :)

[MisterBurns]

@mmat: Ich kann mir ja nicht so ganz vorstellen, dass die Zeile

Code:

If s <> "" Then s = s + ","

so funktioniert ;)

[mmat]

Hello MisterBurns,

doch, die funktioniert so. Teste es mal ...

vg, MM