Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Abhängige Dropdown Boxen mit VBA


Betrifft: Abhängige Dropdown Boxen mit VBA von: Markus
Geschrieben am: 12.09.2019 17:55:52

Liebes Forum,

ich möchte meine 3 Dropdown Boxen mit Hilfe von VBA füllen. Mir ist die indirekt-Variante bekannt, jedoch will ich mein Problem mittels VBA lösen. Die angehängte Musterdatei entspricht vom Aufbau her der Originaldatei. Die 3 Dropdown Boxen sollen voneinander abhängig sein. Die Farben in der Beispielmappe zeigen die Abhängigkeiten. Beispielsweise gehören zur Kategorie 1 die Unterkategorien a-c usw.

https://www.herber.de/bbs/user/132008.xlsm

Der verwendete Code wurde vom Matthias (ebenfalls hier im Forum) erstellt - Danke nochmal! Ich habe versucht ihn an mein Anliegen anzupassen - leider ohne Erfolg.
Kann bitte einer von euch darüber schauen und mir weiterhelfen. Vielleicht gibt müssen die Dropdown-Listen nicht mit Arrays gefüllt werden, da meine Originaldatei etwa 80 Zeilen besitzt?

Vielen Dank euch!

  

Betrifft: AW: Abhängige Dropdown Boxen mit VBA von: 1712778.html
Geschrieben am: 12.09.2019 22:14:25

Moin!
Hier mal eine Variante ohne Array und leichter für dich zum Anpassen. Habe den Beitrag aber mal als offen gelassen. Vllt. hat jemand ja noch eine bessere Idee.
Vorab in DieseArbeitsmappe mal die Zeile hier
For zeile = 2 To 23
so abändern:
For zeile = 2 To 21
Da solltest du nur die Daten nehmen die deine Ausgangwerte sind. In Zeile 23 steht ja aber schon ggf eine Auswahl. Der Wert würde dann zweimal in der Auswahl erscheinen. Deshalb nur bis 21 bzw, deinem Datenendwert. Den Code in Tabelle 1 dann mit dem hier austauschen. Der ist jetzt unabhängig von Array und bezieht sich nur auf deine Daten. An Anfang sind noch 2 Konstanten. Letzte ist dabei die letzte Zeile deiner Werte (hier 21) und ergebnis ist die Zeile, in welcher du die DropDowns hast (bei dir 23). Damit kannst du deinen Code einfacher und schneller anpassen. Sollten es noch mehr Spalten geben, dann im _Chang Ereignis die mit Aufnehmen.

Const letzte = 21
     Const ergebnis = 23
     
     Private Sub Worksheet_Change(ByVal Target As Range)
     On Error GoTo ende
     Application.EnableEvents = False
     Select Case Target.Address
     
         Case "$A$" & ergebnis
      
                 Range("B" & ergebnis).Value = "please choose..."
                 'Range("C23").Value = "please choose..."
                 gültigkeit_einfügen 1, Target.Value, "B" & ergebnis
                 Range("C" & ergebnis).Validation.Delete
                 Range("C" & ergebnis) = ""
                 
         Case "$B$" & ergebnis
                 Range("C" & ergebnis).Value = "please choose..."
                 
                 bereich = Split(Tabelle1.Range("A" & ergebnis).Validation.Formula1, ";")
     
                 auswahl = Application.WorksheetFunction.Match(Tabelle1.Range("A" & ergebnis).Value2, _
      bereich, 0)
                 
                 gültigkeit_einfügen 2, Target.Value, "C" & ergebnis
                 
         Case "$C" & ergebnis
         
         Case Else
     
     End Select
     ende:
     
     Application.EnableEvents = True
     End Sub
     
     
     Sub gültigkeit_einfügen(spalte, suche, ziel)
     'spalte = die Spalte in der gesucht wird, sche der Wert welcher gesucht wird und ziel die  _
     Zielzelle
     On Error GoTo ende
     Dim bereich As Variant
     Dim eintrag As Long
     Dim treffer
     
     bereich = ""
     
     Set treffer = Range(Cells(2, spalte), Cells(letzte, spalte)).Find(suche, LookIn:=xlValues,  _
     lookat:=xlWhole)
     If Not treffer Is Nothing Then
     
         For zeile = treffer.Row To letzte
             If Cells(zeile, spalte) = suche Or Cells(zeile, spalte) = "" Then
                 If Cells(zeile, spalte + 1) <> "" Then bereich = bereich & Cells(zeile, spalte + 1)  _
     & ","
             Else
                 Exit For
             End If
         Next
     
         If bereich = "" Then
             Exit Sub
         Else
             bereich = Left(bereich, Len(bereich) - 1)
         End If
     
         Application.EnableEvents = False
         If bereich <> "=" Then
             With Tabelle1.Range(ziel).Validation
                 .Delete
                 .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                 xlBetween, Formula1:=bereich
                 .IgnoreBlank = True
                 .InCellDropdown = True
                 .InputTitle = ""
                 .ErrorTitle = ""
                 .InputMessage = ""
                 .ErrorMessage = ""
                 .ShowInput = True
                 .ShowError = True
             End With
         End If
     End If
     ende:
     Application.EnableEvents = True
     End Sub
     
     Sub df()
     Application.EnableEvents = True
     End Sub
     

Teste es einfach mal aus.
VG
  

Betrifft: AW: Abhängige Dropdown Boxen mit VBA von: 1712916.html
Geschrieben am: 13.09.2019 14:08:01

Hallo Matthias,

vielen Dank für deine erneute Antwort. Makro funktioniert einwandfrei - jedoch, sobald ich alle Daten eintrage und das Makro entsprechend anpasse, kommt bei mir eine Fehlermeldung: "Wir haben ein Problem bei einigen Inhalten in (Dateiname) erkannt".

Kann es daran liegen, dass bspw. Sonderzeichen wie "&;/" oder Wort-Zahlen-Kombination im Kategorienamen (z.B. TX01) vorkommen?

Vielen Dank!

  

Betrifft: AW: Abhängige Dropdown Boxen mit VBA von: 1712956.html
Geschrieben am: 13.09.2019 15:36:27

Moin!
Also kann so nicht erklären, woran der Fehler liegt. An den Einträgen sollte es m.E. nicht liegen. Lege mal eine neue DAtei an und füge den Code ein. Nach jedem Schritt mal speichern und probieren. Dann mal probieren, ob da auch der Fehler auftritt. Wenn nicht liegt es wohl nicht am Code. DAnn mal die Daten reinkopieren. Ggf. mal in Etappen. Vllt. gibt es ja doch einen Eintrag, der den Fehler verursacht.
Beim COde können noch ein paar Zeilen raus. HIer jetzt verkürtzt:

Const letzte = 21
   Const ergebnis = 23
   
   Private Sub Worksheet_Change(ByVal Target As Range)
   On Error GoTo ende
   Application.EnableEvents = False
   Select Case Target.Address
   
       Case "$A$" & ergebnis
    
               Range("B" & ergebnis).Value = "please choose..."
               'Range("C23").Value = "please choose..."
               gültigkeit_einfügen 1, Target.Value, "B" & ergebnis
               Range("C" & ergebnis).Validation.Delete
               Range("C" & ergebnis) = ""
               
       Case "$B$" & ergebnis
               Range("C" & ergebnis).Value = "please choose..."
               
               gültigkeit_einfügen 2, Target.Value, "C" & ergebnis
               
       Case "$C" & ergebnis
       
       Case Else
   
   End Select
   ende:
   
   Application.EnableEvents = True
   End Sub
   
   
   Sub gültigkeit_einfügen(spalte, suche, ziel)
   'spalte = die Spalte in der gesucht wird, sche der Wert welcher gesucht wird und ziel die _
   Zielzelle
   On Error GoTo ende
   Dim bereich As Variant
   Dim eintrag As Long
   Dim treffer
   
   bereich = ""
   
   Set treffer = Range(Cells(2, spalte), Cells(letzte, spalte)).Find(suche, LookIn:=xlValues, _
   lookat:=xlWhole)
   If Not treffer Is Nothing Then
   
       For zeile = treffer.Row To letzte
           If Cells(zeile, spalte) = suche Or Cells(zeile, spalte) = "" Then
               If Cells(zeile, spalte + 1) <> "" Then bereich = bereich & Cells(zeile, spalte + 1)  _
   _
   & ","
           Else
               Exit For
           End If
       Next
   
       If bereich = "" Then
           Exit Sub
       Else
           bereich = Left(bereich, Len(bereich) - 1)
       End If
   
       Application.EnableEvents = False
       If bereich <> "=" Then
           With Tabelle1.Range(ziel).Validation
               .Delete
               .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
               xlBetween, Formula1:=bereich
               .IgnoreBlank = True
               .InCellDropdown = True
               .InputTitle = ""
               .ErrorTitle = ""
               .InputMessage = ""
               .ErrorMessage = ""
               .ShowInput = True
               .ShowError = True
           End With
       End If
   End If
   ende:
   Application.EnableEvents = True
   End Sub
Sollte der Fehler am Code liegen, können wir auch mal schauen. Ob das evtl. am WorkbookOpen Ereignis liegt. Das könnten wir auch noch ins Blatt übertragen. Tut mir Leid, das ich da grad nicht soviel aus der Ferne helfen kann.

VG
  

Betrifft: AW: Abhängige Dropdown Boxen mit VBA von: 1712967.html
Geschrieben am: 13.09.2019 16:09:12

Hallo Matthias,

Vielen Dank dir für die Antwort und den neuen Code.

Wenn ich dir Datei neu erstelle (mit Code) speichere und dann wieder öffne läuft alles.

Wenn ich die Datei dann wieder schließen will, werde ich gefragt, ob ich diese speichern will - drücke ich auf "JA" kommt beim nächsten Öffnen die besagte Fehlermeldung. Hast eine Idee?

  

Betrifft: AW: Abhängige Dropdown Boxen mit VBA von: 1713140.html
Geschrieben am: 14.09.2019 22:21:27

Moin!
Kann dir leider nicht sagen, woran das liegt. Wenn du eine neue Datei hast und den Code reingepackt hast, funktioniert alles? Auch mehrfach (wenn noch keine Daten drin sind) oder tritt das der Fehler auch schon auf? Ich würde da Schritt für Schritt die Datei neu erstellen und mal testen (mehrfach). Vllt. kann man es ja eingrenzen. Bspw. Mal nur eine neue Datei mit den Daten ohne Code. Mehrfach öffnen und schließen. Fehler ja/nein. Dann Code dazu und wieder testen. Dann mal andersherum. ALso erst Code aber keine Daten in dem Blatt (sollte kein Fehler entstehen) und Öffnen und Schließen. Dann mal die Daten dazu. Und wiede testen.
Wenn nicht, wie kopierst du den deine Daten in die Datei? Mit Copy/Paste (markiren und übertragen) oder exportiertst du das Blatt? Wen letzteres der Fall ist, könnte das ggf. den Fehler auslösen. Dann übertrage die Daten mal mit Copy/Paste. Evl nochmal probieren, dass du ertmal nur 20 Zeilen kopierst und testest. Wen das geht, dann langsam erweitern (vllt. iegt es ja doch an den Daten). Wenn da immer noch de Fehler auftritt bzw. du es eingrenzen kannst (je nach Konstellation) kopiere mal die Daten nicht (ggf, den fehlerbehafteten Teil) und trage sie manuelle komplett neu ein.
Hier mal die Datei als xls. Habe dabei noch den COde aus DieseArbeitsmappe entfernt und nur noch COde im Blatt. Vllt. hilft das dann.
https://www.herber.de/bbs/user/132041.xls
Der Fehler tritt aber nur bei der Date auf oder? Falls nicht könnte es ggf am Office liegen. Kann leider grad nicht helfen.
Wenn der Fehler weiter besteht, mach bitte mal einen neuen Thread zu diesem Fehler auf. Vllt. kennt ja jemand eine Lösung (außer Neuinstallation).
VG

  

Betrifft: AW: Abhängige Dropdown Boxen mit VBA von: 1713142.html
Geschrieben am: 14.09.2019 22:28:18

Vllt. kann das noch helfen:
http://de.repairmsexcel.com/blog/reparatur-excel-2013-inhalt-error
https://administrator.de/forum/excel-problem-einigen-inhalten-373360.html

Evtl. auch mal ohne und mit Formatierung neu erstellen.
VG

  

Betrifft: AW: Abhängige Dropdown Boxen mit VBA von: 1712940.html
Geschrieben am: 13.09.2019 15:01:23

Hallo Markus

ich habe mich auch mal um eine Lösung bemüht, bekomme es aber den Code nicht so elegant hin wie Matthias.
Schau bitte mal ob er dir trotzdem weiter hilft, bist du vielleicht einen besseren bekommst ...
Eine Option ist offen, beim anklicken von DropDown3. Da meldet eine MsgBox das hier noch kein Programm vorliegt.

https://www.herber.de/bbs/user/132028.xlsm

mfg Piet

Beiträge aus dem Excel-Forum zum Thema "Abhängige Dropdown Boxen mit VBA"