Clever-Excel-Forum

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ß!

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

Hallo,

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

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

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

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

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

so funktioniert ;)

Hello MisterBurns,

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

vg, MM

diving_excel

Elex

mmat

diving_excel

MisterBurns

mmat