Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1740to1744
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

VBA: ComboBox Zellbereich zuweisen 2nd

VBA: ComboBox Zellbereich zuweisen 2nd
26.02.2020 12:38:16
Charly
Hallo,
ich komm mit meinem alten (neu) Project nicht weiter.
Vieleicht ist ja Matthias der mir vor einigen Wochen geholfen hat heute auch im Forum anwesend.
Aber ich nehme auch jede Hilfe von anderen Mitglieder dankend an.
Mein Problem:
Ich Möchte in einer UF mehrere ComboBoxen Verschachteln u. Werte in den CB´s Anzeigen lassen, hierzu hatte mir Matthias geholfen. Klappt auch wunder bar.
Aber nun habe Ich mit meinem Vorgesetzten darüber gesprochen u. sind nach langer Diskussion zum Schluss gekommen das Ich die UF nochmals überarbeite. Es müssen die Werte nun in separate Spalten eingetragen u. in die CB´s geladen werden (Es Handelt sich hierbei um Hilfsmittel im Pflegebreich).
Bisher werden die Modelle in die Tabelle manuell geschrieben. Mehrere Model-Arten in einer Spalte. Dies muss nun ändern werden, habe auch schon angefangen dies Umzusetzen aber nun komme Ich nicht mehr weiter.
Es geht um die UF „meineUF_Neu“:
5 ComboBoxen, 1 ListBox, 2 TextBoxen, 4 Button
CB1 „Lieferant“, CB2 „Hersteller“, CB3 „Leistung“, CB4 „Model-Bauart“, CB5 „Model-Art“,
LB1 „Model“. Die CB1 wird per UF Initialisierung Eingelesen (Tabellenblätter).
Man wählt im ersten Schritt die CB1 einen Lieferanten aus, im nächsten Schritt wählt man in der CB2 die zur Verfügungsstehenden Hersteller aus. Im dritten Schritt werden die vom Hersteller in Abhängigkeit ob es sich hierbei um Kassen.- od. um Privatleistungen in der CB3 Handel die Model-Bauarten in der CB4 zur Auswahl gestellt. Im 5 Schritt werden dann die Model-Arten in CB5 zur Auswahl bereitgestellt. Nun wählt man eine dieser Model-Arten aus im Anschluss werden dann alle Modelle dieser Klasse in einer ListBox angezeigt. Soweit die Theorie.
Probleme habe Ich mit dem 5 Schritt, da komm Ich nicht weiter.
CB4 hat Einträge die zur Auswahl stehen, anhand dieser werden dann die Model-Arten Bereitgestellt. Jede „Model-Bauform“ hat 3 „Model-Arten“, in meiner UF werden mir aber drei gleiche Model-Arten angezeigt. So sollte es nicht sein.

Ich hoffe es ist Halbwegs Verständlich.
Danke schon mal für jegliche Hilfe im Voraus!
Hier Meine Bsp.-Mappe
https://www.herber.de/bbs/user/135453.xlsm
Gruß Charly

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA: ComboBox Zellbereich zuweisen 2nd
26.02.2020 19:02:25
Matthias
Moin!
Also das mit den selben Werte liegt daran, dass du bei den drei .additem den Spaltenindex immer um 3 erhöhst. Damit hast du aber immer den selben Namen. Dort musst du drei fortlaufende Spalten nehmen. Bei der Spaltenberechnung hast du die Listbox mit eingebaut. DAS sollte m.E. das Ergebnis verändern. habe ich Rausgenommen. So sollte der Code funktioniten.

Option Explicit
Private Sub CB_Lieferant_Change()
Dim spalte As Long
Me.CB_Hersteller.Clear
Me.CB_Leistung_Art.Clear
Me.CB_Model_Bauform.Clear
Me.CB_Model_Art.Clear
Me.LB_Model.Clear
With Worksheets(Me.CB_Lieferant.Value)
spalte = 2
Do
Me.CB_Hersteller.AddItem .Cells(2, spalte)
spalte = spalte + .Cells(2, spalte).MergeArea.Columns.Count
Loop While (.Cells(2, spalte)  "")
End With
End Sub
Private Sub CB_Hersteller_Change()
Dim spalte As Long, ende As Long
Me.CB_Leistung_Art.Clear
Me.CB_Model_Bauform.Clear
Me.CB_Model_Art.Clear
Me.LB_Model.Clear
If CB_Hersteller.ListIndex = -1 Then Exit Sub
With Worksheets(Me.CB_Lieferant.Value)
spalte = 2 + CB_Hersteller.ListIndex * 18       'max. 18 Spalten
ende = 2 + (CB_Hersteller.ListIndex + 1) * 18
Do
Me.CB_Leistung_Art.AddItem .Cells(3, spalte)    'Leistungs-Art Zeile 3
spalte = spalte + .Cells(3, spalte).MergeArea.Columns.Count
Loop While (.Cells(3, spalte)  "" And spalte 

VG
Anzeige
AW: VBA: ComboBox Zellbereich zuweisen 2nd
26.02.2020 19:19:15
Charly
Hallo Matthias,
DANKE, DANKE, DANKE für deine Rückmeldung.
Werd Ich später Testen.
Grüß Charly
AW: VBA: ComboBox Zellbereich zuweisen 2nd
26.02.2020 20:40:03
Matthias
Moin!
Eine Ergänzung noch. Hatte deine alte Datei nicht und arbeite grad in Ex03.
Beim Eintragen habe ich wieder nicht geprüft, ob da nur ein Wert drin steht. Das müsstest du dann noch mit einbauen (so wie beim letzten Mal). Püfen ob zeile = 5 dann Abbruch, bei 6 nur additem und ansosnten die Zuweisung an .list wie oben im Code.
VG
AW: VBA: ComboBox Zellbereich zuweisen 2nd
27.02.2020 14:00:52
Charly
Hallo Matthias,
deinen Hinweis, habe Ich direkt Umgesetzt. Danke u. Funktioniert alles Bestens.
Jetzt hätte Ich noch eine Bitte, ob du mir beim Eintragen/Austragen von Modellen
auch Helfen könntest.

Vieleicht viel die bei der neuen UF etwas auf das Vorher nicht in der alten UF eingeplant war.
Mein Vorhaben manuell in die Tabellen zu Schreiben ist nach dem Gespräch mit meinem
Vorgesetzten nicht sinngemäß.
Hier mein Vorhaben:
In der Neuen UF habe Ich zwei TextBoxen Eingebaut u. einen dazu gehörigen Button.
Je nachdem welche TB genutzt wird, muss Berücksichtigt werden was nach
dem Click auf dem Button passieren soll.
Wenn man ein Model Einträgt u. den Button Klickt, dann soll folgendes passieren:
1. Model Eingeben (TB1)
a. Suche in der jeweiligen Spalte nach dem Zellinhalt „k. w. Modelle“
b. Kopiere die Zelle od. den Inhalt u. füge diese eine Zelle darunter wieder ein.
c. Nun Trage das neue Modell in die Zelle über „k. w. Modelle“ ein
d. Sortiere alle Einträge oberhalb von „k. w. Modelle“ alphabetisch.
(Nur, wenn dies möglich ist.)
2. Model Austragen
(Hier bin Ich mir nicht sicher ob Ich die TB3 oder die LB_Model nutze)
Bsp. über TB3
a. Suche das Eingetragene Model in der jeweiligen Spalte
• Es kann vorkommen das in mehrere Spalten das gleiche Model steht
(Bsp.: Standard-RO: „Senio“ u. Diagnose-RO: „Senio SRL“
b. Lösche das Gesuchte Model in dieser Spalte
c. Alphabetische Sortierung von Zeile 6 bis X
• Hierbei ist x immer die letzte Zelle vor „k. w. Modelle“
d. Kopiere die Zelle od. den Inhalt „k. w. Modelle“ in die darüber freie Zell.
e. Zuletzt die Zelle unter „k. w. Modelle“ den Inhalt leeren
od. Bsp. über LB_Model
a. Klicke ein Model in der LB_Model an
b. Suche das Markierte Model in der jeweiligen Spalte
• Es kann vorkommen das in mehrere Spalten das gleiche Model stehen
(Bsp.: Standard-RO: „Senio“ u. Diagnose-RO: „Senio SRL“
c. Lösche das Markierte/Gesuchte Model in dieser Spalte
d. Alphabetische Sortierung von Zeile 6 bis X
e. Hierbei ist x immer die Zelle vor „k. w. Modelle“
f. Kopiere die Zelle od. den Inhalt „k. w. Modelle“ in die darüber freie Zell.
g. Zuletzt die Zelle unter „k. w. Modelle“ den Inhalt leeren
Gruß Charly
Anzeige
AW: VBA: ComboBox Zellbereich zuweisen 2nd
27.02.2020 18:44:04
Matthias
Moin!
Also ehrlich gesagt, war dein letzte Aufbau mit den Daten unten auch nicht wirklich optimal. :-)
HIer mal eine Variante. Teste sie mal. Die Auswahl wird nur in der Spalte gelöscht? Die Auswahl zum Löschen erfolgt durch Klick in die Listbox (damit wird es ausgewählt) und bestätigen mit OK. Die Spalte trageich in die Tag Eigenschaft der LB ein. Damit ahst du gleich die Spalte parat. Die wird bei jeder B gelöscht. Deshalb den ganzen Code tauschen oder alle Änderungen beachten.

Option Explicit
Private Sub CB_Lieferant_Change()
Dim spalte As Long
Me.CB_Hersteller.Clear
Me.CB_Leistung_Art.Clear
Me.CB_Model_Bauform.Clear
Me.CB_Model_Art.Clear
Me.LB_Model.Clear
Me.LB_Model.Tag = ""
With Worksheets(Me.CB_Lieferant.Value)
spalte = 2
Do
Me.CB_Hersteller.AddItem .Cells(2, spalte)
spalte = spalte + .Cells(2, spalte).MergeArea.Columns.Count
Loop While (.Cells(2, spalte)  "")
End With
End Sub
Private Sub CB_Hersteller_Change()
Dim spalte As Long, ende As Long
Me.CB_Leistung_Art.Clear
Me.CB_Model_Bauform.Clear
Me.CB_Model_Art.Clear
Me.LB_Model.Clear
Me.LB_Model.Tag = ""
If CB_Hersteller.ListIndex = -1 Then Exit Sub
With Worksheets(Me.CB_Lieferant.Value)
spalte = 2 + CB_Hersteller.ListIndex * 18       'max. 18 Spalten
ende = 2 + (CB_Hersteller.ListIndex + 1) * 18
Do
Me.CB_Leistung_Art.AddItem .Cells(3, spalte)    'Leistungs-Art Zeile 3
spalte = spalte + .Cells(3, spalte).MergeArea.Columns.Count
Loop While (.Cells(3, spalte)  "" And spalte  "" And Me.TextBox3  "k. w. Modelle" Then
For zeile = 6 To ende
If .Cells(zeile, spalte) = Me.TextBox3.Value Then Exit For
Next
If zeile  7 Then
.Range(.Cells(6, spalte), .Cells(ende - 2, spalte)).Sort Key1:=.Cells(6, spalte),  _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End If
End If
'einfügen
If Me.TextBox1  "" Then
.Cells(ende, spalte).Insert Shift:=xlDown
.Cells(ende, spalte) = Me.TextBox1
If ende > 6 Then
.Range(.Cells(6, spalte), .Cells(ende, spalte)).Sort Key1:=.Cells(6, spalte), Order1:= _
xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End If
End If
End With
Call CB_Model_Art_Change
End Sub
Private Sub LB_Model_Click()
If Me.LB_Model.ListIndex = -1 Then Exit Sub
Me.TextBox3 = Me.LB_Model
End Sub
Private Sub TextBox3_Change()
End Sub
Private Sub UserForm_Initialize()
' Hier werden alle Lieferanten der jeweilgen Tabell in die ("CB_Lieferanten") geladen.
Dim i As Long
For i = 1 To Worksheets.Count
CB_Lieferant.AddItem Worksheets(i).Name
Next
End Sub
Private Sub Cbu_NeuStart_Click()
Unload Me
meineUF_Neu.Show
End Sub
Private Sub Cbu_OK_Click()
MsgBox "Sie haben gewählt: " & vbNewLine & "Lieferant:" & " " & CB_Lieferant.Text & _
vbNewLine & "Hersteller:" & " " & CB_Hersteller.Text & _
vbNewLine & "Leistungs-Art:" & " " & CB_Leistung_Art.Text &  _
_
vbNewLine & "Model-Bauform:" & " " & CB_Model_Bauform.Text & _
_
vbNewLine & "Model-Art:" & " " & CB_Model_Art.Text & _
vbNewLine & "Model:" & " " & LB_Model.Text
End Sub
Private Sub Cbu_Close_Click()
Unload Me
End Sub

VG
Anzeige
AW: VBA: ComboBox Zellbereich zuweisen 2nd
28.02.2020 15:02:21
Charly
Hallo Matthias,
DANKE FÜR DEINE RÜCKMELDUNG... Habe dein Code getestet, wie folgt das Ergebnis.
Eintragen per CB Auswahl u. TB
- Strehlow, Bischoff & Bischoff, Kasse, RO (B&B), Standard-Model
Löschen per CB Auswahl, Klick in LB u. Button "OK"
- Strehlow, Bischoff & Bischoff, Kasse, RO (B&B), Standard-Model, Model(LB)
Eintragen von Modellen:
Testet halber 3 Model eingetragen, nach Klick "OK"
- Versetzung von "k. w. Modelle"
- Eintragung des neuen Modells
- anschließend die Sortierung
Funktioniert einwandfrei...
Löschen von Modellen:
Wenn Ich nun die Test Modelle lösche, die Ich Eingetragen habe per Klick in LB u. dann "OK" Button.
- Löschen des Models
- anschließend die Sortierung
- Versetzung von "k. w. Modelle"
Funktioniert einwandfrei...
Da Ich die Test Modelle wieder gelöscht habe, stehen in der Spalte nun wieder diese Einträge
("Rollator B XXL", "Senio" u. k. w. Modelle)
- Lösche Ich nun das Model "Senio" in dieser Spalte über die UF kommt folgende Fehlermeldung,
  Laufzeitfehler "1004"
Für diese Aktion müssen alle Verbundenen Zellen dieselbe Größe haben.
Bezieht sich auf diese Zeile im CommandButton1_Click:
'löschen
If Me.TextBox3  "" And Me.TextBox3  "k. w. Modelle" Then
For zeile = 6 To ende
If .Cells(zeile, spalte) = Me.TextBox3.Value Then Exit For
Next
If zeile  7 Then
        .Range(.Cells(6, spalte), .Cells(ende - 2, spalte)).Sort Key1:=.Cells(6, spalte),  _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End If
End If
Gruß Charly
Anzeige
AW: VBA: ComboBox Zellbereich zuweisen 2nd
28.02.2020 17:14:22
Matthias
Moin!
Upps, da hat sich ein Fehler eingschlichen. Hatte eingentlich fast alles gestestet. Ändere den Kopf am Anfang mal in das ab:
If ende > 8 Then

Dann sollte es passen. Bei der erstn Variante ist sonst Anfang und Ende der Range identisch = Fehler.
VG
AW: VBA: ComboBox Zellbereich zuweisen 2nd
28.02.2020 18:41:59
Charly
Hallo Matthias,
habe die Korrektur übernommen. Funktioniert jetzt super.
Hab da eine Kleinigkeit noch festgestellt, wenn z.B. in Spalte "I",
dort stehen zwei Einträge ("k. A." u. "k. w. Modelle"):

- wenn Ich in dieser Spalte ein Model über die UF Eintrage, passiert nur das was passieren soll.
Wenn Ich folgend Reihenfolge durchlaufe passiert folgendes:
- Die CB´s werden gewählt (in dem Fall Spalte „I“ oh. Model Eintrag)
- Klicke in der LB den Eintrag "k. A." an u. dann auf OK
- "k. A." wurde gelöscht, wie gewollt
- Trage nun ein Model in diese Spalte ein
- Das Model wird in die Spalte eingetragen, Versetzung von "k. w. Modelle" u.
Sortierung erfolgen im Anschluss.
Aber es wird die Formatierung von der darüber liegenden Zelle (Beschriftung) in die eben Beschriebene Zelle mitübernommen. Passiert mit jedem weiten Eintrag in der Spalte.
- Habe dies mit anderen Spalte (ebenfalls mit "k. A." u. "k. w. Modelle“) getestet,
es ist dann der gleiche Effekt wie oben beschrieben.

Hier mal ein Screen:
Userbild
Gruß Charly
Anzeige
AW: VBA: ComboBox Zellbereich zuweisen 2nd
28.02.2020 19:16:50
Matthias
Moin!
Den Code vom Button hiermit austauschen. War auch noch ein anderer Fehler drin.
Private Sub CommandButton1_Click()
'eintrag oder Löschen
Dim ende As Long, spalte As Long, zeile As Long
If Me.LB_Model.Tag = "" Then Exit Sub
spalte = Me.LB_Model.Tag
With Worksheets(Me.CB_Lieferant.Value)
ende = .Cells(.Rows.Count, spalte).End(xlUp).Row
'löschen
If Me.TextBox3  "" And Me.TextBox3  "k. w. Modelle" Then
For zeile = 6 To ende
If .Cells(zeile, spalte) = Me.TextBox3.Value Then Exit For
Next
If zeile  8 Then
.Range(.Cells(6, spalte), .Cells(ende - 2, spalte)).Sort Key1:=.Cells(6, spalte),  _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End If
If zeile  "" Then
.Cells(ende, spalte).Insert Shift:=xlDown
.Cells(ende, spalte) = Me.TextBox1
If ende = 6 Then
.Cells(ende + 1, spalte).Copy
.Cells(ende, spalte).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End If
If ende > 6 Then
.Range(.Cells(6, spalte), .Cells(ende, spalte)).Sort Key1:=.Cells(6, spalte), Order1:= _
xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End If
End If
End With
Call CB_Model_Art_Change
End Sub

DAnn mal testen und wenn es nicht passt, bitte nochmal melden.
VG
Anzeige
AW: VBA: ComboBox Zellbereich zuweisen 2nd
28.02.2020 21:15:19
Charly
Hallo Matthias,
hab deine Änderung des Buttons Übernommen, Funktioniert Super.
Besten Dank für deine Zeit u. die Hilfe bei meinem Anliegen.
Gruß Charly

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige