dropdown

[Rabe]

Hi,

Ausser dass ich mehrere Dropdowns in einem
Worksheet ansprechen möchte.
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range) ' gibt hier einen Fehler aus Mehrdeutiger Name: Worksheet_Change

es darf nur ein Worksheet_Change-Ereignis geben.

Du hast eine veraltete Version des Makros!
Es werden keine Dropdowns mehr benötigt, siehe die angehängte Datei V4.
Schau Dir mal das erweiterte Makro an, da sind mehrere Doppelklickzellen drin, diese können in diesem Stil einfach erweitert werden.

Option Explicit kommt immer oben als erstes ein Mal über alle Makros.

[hagi6312]

Hallo Ralf
Verstehe es nicht ganz!
Wollte es so wie untenstehend lösen?

Dieses anstatt der Dropdown:

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

    If Target.Address <> "$G$8:$g$849" Then Exit Sub '
        Target.Value = "x"
End Sub

Dieses für nicht Ausgeführte Arbeiten:

Private Sub Option Explicit(ByVal Target As Range)
   
    'PVC-Sockel (Abzug Total für nicht Ausgeführte Arbeiten.)
    If Target.Address <> "$G$429" Then Exit Sub
   
    If Target.Value = "x" Then
        Range("G430:G452").Value = "x"
    Else: Range("G430:G452").Value = ""
    End If
   
End Sub
 Private Sub Option Explicit(ByVal Target As Range)
 
    'Holzsockel (Abzug Total für nicht Ausgeführte Arbeiten.)
    If Target.Address <> "$G$456" Then Exit Sub
   
    If Target.Value = "x" Then
        Range("G457:G485").Value = "x"
    Else: Range("G457:G485").Value = ""
    End If
   
End Sub
Option Explicit
   
    'Endreinigung   (Abzug Total für nicht Ausgeführte Arbeiten.)
    If Target.Address <> "$G$489" Then Exit Sub
   
    If Target.Value = "x" Then
        Range("G490:G495").Value = "x"
    Else: Range("G490:G495").Value = ""
    End If
   
End Sub
Option Explicit
   
    'Linol Reparatur (Abzug Total für nicht Ausgeführte Arbeiten.)
    If Target.Address <> "$G$529" Then Exit Sub
   
    If Target.Value = "x" Then
        Range("G530:G49").Value = "x"
    Else: Range("G530:G49").Value = ""
    End If
   
End Sub


Kannst Du mir dieses Bitte richtig stellen! :22: :05:

[Rabe]

Hi,

Kannst Du mir dieses Bitte richtig stellen! :22: :05:

schau mal hier:

Option Explicit  ' nur ein Mal am Anfang jeder Codeseite 

Private Sub Worksheet_Change(ByVal Target As Range)     'nur ein Worksheet-Change pro Worksheet 
   
   'Wenn die Zieladresse nicht H3 ist, dann Makro verlassen 
   If Target.Address <> "H3" Then Exit Sub

   If Target.Value = "x" Then
       Range("E4:E8").Value = "x"
   Else: Range("E4:E8").Value = ""
   End If
   
   'PVC-Sockel (Abzug Total für nicht Ausgeführte Arbeiten.) 
   'Wenn die Zieladresse nicht G429 ist, dann Makro verlassen 
   If Target.Address <> "G429" Then Exit Sub
  
   If Target.Value = "x" Then                  'wenn ein x in der Zelle G429 steht, dann 
       Range("G430:G452").Value = "x"          'schreiben eines x in Bereich G430 bis G452 
   Else: Range("G430:G452").Value = ""         'anderenfalls löschen der x 
   End If

   'Holzsockel (Abzug Total für nicht Ausgeführte Arbeiten.) 
   If Target.Address <> "G456" Then Exit Sub
  
   If Target.Value = "x" Then
       Range("G457:G485").Value = "x"
   Else: Range("G457:G485").Value = ""
   End If
  
   'Endreinigung   (Abzug Total für nicht Ausgeführte Arbeiten.) 
   If Target.Address <> "G489" Then Exit Sub
  
   If Target.Value = "x" Then
       Range("G490:G495").Value = "x"
   Else: Range("G490:G495").Value = ""
   End If
  
   'Linol Reparatur (Abzug Total für nicht Ausgeführte Arbeiten.) 
   If Target.Address <> "G529" Then Exit Sub
  
   If Target.Value = "x" Then
       Range("G530:G549").Value = "x"
   Else: Range("G530:G549").Value = ""
   End If
  
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)     'nur ein Worksheet_BeforeDoubleClick pro Worksheet 
   If Intersect(Target, Range("H3,E4:E8,G8:G849")) Is Nothing Then Exit Sub  'mehrere Bereiche durch Komma getrennt 
   If Target.Count > 1 Then Exit Sub                           'wenn mehr als eine Zelle markiert, Makro verlassen 
   If Target.Value = "x" Then                                  'wenn Target-Zelle ein x enthält 
       Target.Value = ""                                       'dann Target-Zelle leeren 
   Else: Target.Value = "x"                                    'ansonsten ein in die Target-Zelle x schreiben 
   End If
End Sub

VBA/HTML - CodeConverter für Office-Foren, AddIn für Excel/Word 2000-2013 - komplett in VBA geschrieben von Lukas Mosimann. Projektbetreuung durch mumpel
Code erstellt und getestet in Office 15

[WillWissen]

Hi,

schau mal hier:

Option Explicit  ' nur ein Mal am Anfang jeder Codeseite

das musst du nicht einmal händisch eintragen - gehe über Extras/Optionen und mach ein Häkchen bei "Variablendeklaration notwendig" rein. Dann steht das Option Explicit automatisch immer am Anfang drin.

   

[Kuwer]

Hi Ralf,

hast Du den Code getestet?
Es wird Dank "Exit Sub" nur bei H3 funktionieren.
Ich hatte das z.B. auch schon hier kritisiert.

Gruß Uwe

[hagi6312]

Hallo Ralf
Neuer Fehler
 Sorry :05: :22:

[WillWissen]

Hi,

die Fehlermeldung sagt dir doch schon, welcher Fehler auftritt. Du hast ein End Sub zuviel oder ein Private Sub zuwenig.

[Rabe]

Hi Uwe,

hast Du den Code getestet?
Es wird Dank "Exit Sub" nur bei H3 funktionieren.

Nein.

oooh, das stimmt, das habe ich nicht bedacht.

Vielleicht so:

Option Explicit  ' nur ein Mal am Anfang jeder Codeseite 

Private Sub Worksheet_Change(ByVal Target As Range)     'nur ein Worksheet-Change pro Worksheet 
    
    If Target.Address = "$H$3" Then      'Wenn die Zieladresse = H3 ist, dann nächste Abfrage 
    If Target.Value = "x" Then           'wenn ein x in der Zelle H3 steht, dann 
    Range("E4:E8").Value = "x"           'schreiben eines x in Bereich E4 bis E8 
Else: Range("E4:E8").Value = ""          'anderenfalls löschen der x 
    End If
    
ElseIf Target.Address = "$G$429" Then    'PVC-Sockel (Abzug Total für nicht Ausgeführte Arbeiten.) 
    If Target.Value = "x" Then           'wenn ein x in der Zelle G429 steht, dann 
    Range("G430:G452").Value = "x"       'schreiben eines x in Bereich G430 bis G452 
Else: Range("G430:G452").Value = ""      'anderenfalls löschen der x 
    End If
    
ElseIf Target.Address = "$G$456" Then    'Holzsockel (Abzug Total für nicht Ausgeführte Arbeiten.) 
    If Target.Value = "x" Then
    Range("G457:G485").Value = "x"
Else: Range("G457:G485").Value = ""
    End If
    
ElseIf Target.Address = "$G$489" Then    'Endreinigung (Abzug Total für nicht Ausgeführte Arbeiten.) 
    If Target.Value = "x" Then
    Range("G490:G495").Value = "x"
Else: Range("G490:G495").Value = ""
    End If
    
ElseIf Target.Address = "$G$529" Then    'Linol Reparatur (Abzug Total für nicht Ausgeführte Arbeiten.) 
    If Target.Value = "x" Then
    Range("G530:G549").Value = "x"
Else: Range("G530:G549").Value = ""
    End If
    End If
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)       'nur ein Worksheet_BeforeDoubleClick pro Worksheet 
    If Intersect(Target, Range("$H$3,$E$4:$E$8,$G$8:$g$849")) Is Nothing Then Exit Sub  'mehrere Bereiche durch Komma getrennt 
    If Target.Count > 1 Then Exit Sub                       'wenn mehr als eine Zelle markiert, Makro verlassen 
    If Target.Value = "x" Then                              'wenn Target-Zelle ein x enthält 
    Target.Value = ""                                       'dann Target-Zelle leeren 
Else: Target.Value = "x"                                    'ansonsten ein x in die Target-Zelle schreiben 
    End If
End Sub

VBA/HTML - CodeConverter für Office-Foren, AddIn für Excel/Word 2000-2013 - komplett in VBA geschrieben von Lukas Mosimann. Projektbetreuung durch mumpel
Code erstellt und getestet in Office 15

@mumpel:
der Einrückteil Deines Tools bricht ab mit der Fehlermeldung: Fehler in der Funktion fstrSchlüsselwortEinrücken! Aufruf:If

[hagi6312]

Danke 
war der End Sub :15: :18:

[Rabe]

Hi,

Danke 
war der End Sub :15: :18:

wie Uwe geschrieben hat, funktioniert es noch nicht richtig, bzw. nur für H3.

ich habe das Makro nochmal überarbeitet, s.o. Beitrag 18