Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1948to1952
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Problem mit meinem VBA Code

Problem mit meinem VBA Code
12.10.2023 01:38:58
Minke1975
Hallo kann mir jemand helfen,
ich möchte mit meinem VBA code per Doppelklick ein x in verschiedene Zellen setzen, das funktioniert auch. Nun möchte ich aber das in den Bereichen b4:f4, b5:f5 usw jeweils nur ein x eingetragen werden kann. Leider klappt das nicht, da ich nicht weiß, wie ich die Range dafür angeben muss.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
' x in die Zelle
Dim RaBereich As Range
Set RaBereich = Range("b4:f9,b12:f16,b19:f21,b24:f28,b31:f37,b45:f49,b52:f56,b59:f65,b72:f75,b78:f81,b84:f90,b97:f104,b107:f111,b114:f119")
If Intersect(Target, RaBereich) Is Nothing Then Exit Sub
' Abbruch, wenn Aktion nicht im Zielbereich
Application.EnableEvents = False
Cancel = True
If Target.Value = "x" Then
Target.Value = ""
Else
Target.Value = "x"
End If
Application.EnableEvents = True
Set RaBereich = Nothing

Dim rng1 As Range, rng2 As Range
Dim Eingabe As String
Set rng2 = Range("b4:f4")
Set rng1 = Intersect(Target, rng2)
If Not rng1 Is Nothing Then
Application.EnableEvents = False
Eingabe = rng1(1).Formula
rng2.ClearContents
rng1(1).Formula = Eingabe
Application.EnableEvents = True
End If

End Sub

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Problem mit meinem VBA Code
12.10.2023 01:57:12
onur
DAS genügt völlig:
Private Sub Worksheet_BeForeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim ze
ze = Target.Row
Dim RaBereich As Range
Set RaBereich = Range("B4:F9,B12:F16,B19:F21,B24:F28,B31:F37,B45:F49,B52:F56,B59:F65,B72:F75,B78:F81,B84:F90,B97:F104,B107:F111,B114:F119")
If Intersect(Target, RaBereich) Is Nothing Then Exit Sub
If Target = "X" Then Target = "": Cancel = True: Exit Sub
If WorksheetFunction.CountIf(Range("B" & ze & ":F" & ze), "X") = 0 Then Target = "X"
Cancel = True
End Sub
Anzeige
AW: Problem mit meinem VBA Code
12.10.2023 02:04:56
Minke1975
Hallo onur,
super das hat funktioniert. Danke

Gruß Minke
Gerne !
12.10.2023 02:06:30
onur

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige