Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Combobox Fokus auf gefilterte Daten
Michael
Hallo liebes Forum,
nach reichlicher Recherche in den Foreneinträgen bin ich leider nicht weitergekommen und bitte daher um eure Hilfe.
Meine Frage:
ist es grundsätzlich möglich, einer Combobox auf einer UF individuell gefilterte Daten einer Exceltabelle zuzuweisen und in dieser cbo dann auch nur den gefilterten Datenbestand anzeigen/auswählen zu lassen?
Hintergrund sind 2 Excelsheets als Datenbanken -1x für die Verwaltung von Rechnungsadressen (Sheet Daten_RG) und 1x für die Verwaltung der zur RG-Adresse gehörenden n-Objektadressen (Sheet Daten_Obj) - zu bearbeiten in 2 getrennten Frames auf einer Userform.
Die RG-Anschrift erhält stets eine ID (letzte +1), die als Verweis für die spätere Zugehörigkeit der Obj-Adr zur RG_Adr dienen soll.
So:
cbo_Adr_RG in Frame1 ' alle RG-Adr
cbo_Adr_Obj in Frame2 ' Obj_Adr gefiltert nach ausgewählter RG_Adr.
Dank im Voraus!
Gruß,
Michael
von einander abhängige ComboBoxes
25.01.2011 17:56:32
einander
Hallo Michael,
wenn ich dich richtig verstehe, sollen in ComboBox2 nur die Einträge gelistet werden, die zu dem gewählten Eintrag aus ComboBox1 gehören.
Prinzip:
- wenn Auswahl in cbo1 geändert wird, Liste der cbo2 leeren ( mit ComboBox2.clear )
- durchlaufe "Sheet Daten_Obj" und suche nach den passenden Werten zu Eintrag aus cbo1
- füge den Wert bei cbo2 ein ( mit ComboBox2.AddItem Wert )
Alternative zum letzten Punkt: schreibe die Werte in ein Array und übergebe das Array an die cbo2
( mit ComboBox2.List = arrWerte )
RowSource darfst du hierbei nicht setzen.
Gruß
Christian
Anzeige
AW: von einander abhängige ComboBoxes
25.01.2011 20:17:21
einander
Hallo Christian,
besten Dank für den Tipp. Ich bin mir nur nicht sicher, wie ich die Routine erstellen kann.
Hier der Code für cbo_cbo_Adr_RG ' in Frame1, mit dem ich den Filter in der "Daten_Obj" setze, was funktioniert. Nur dann ist mir unklar, wie ich den Filter in der cbo_Adr_Obj aufrufen kann. Aber ich sehe schon, dass dein Vorschlag einen ganz anderen aber interessanten Weg geht. Kannst du mir das mit dem Array mal am BSP zeigen?
Dank im Voraus, Michael
Hier die aktuelle Version....:
'Ändern der RG-Anschrift
'Combobox-Auswahl - RG_Firma zur Änderung
Private Sub cbo_Firma_RG_change_Change()
Worksheets("Daten").Activate
If cbo_Firma_RG_change.ListIndex = -1 Or cbo_Firma_RG_change.Value = "" Then
cmd_Adress_RG_change_save.Enabled = False
'  cmd_Obj_Anschr_ergaenz.Visible = False
Else
cmd_Adress_RG_change_save.Enabled = True
' cmd_Obj_Anschr_ergaenz.Enabled = True
End If
Application.ScreenUpdating = False
Me.txt_ID_RG_change.Value = Sheets("Daten").Range("A" & cbo_Firma_RG_change.ListIndex + 2). _
Value
Me.txt_Firma_rg_change.Value = Sheets("Daten").Range("E" & cbo_Firma_RG_change.ListIndex +  _
2).Value
'Spalte1 oben
Me.txt_Firma_rg_change.Value = Sheets("Daten").Range("E" & cbo_Firma_RG_change.ListIndex +  _
2).Value
Me.txt_Firma2_RG_change.Value = Sheets("Daten").Range("F" & cbo_Firma_RG_change.ListIndex +  _
2).Value
Me.txt_Firma3_RG_change.Value = Sheets("Daten").Range("G" & cbo_Firma_RG_change.ListIndex +  _
2).Value
Me.txt_plzPF_RG_change.Value = Sheets("Daten").Range("H" & cbo_Firma_RG_change.ListIndex +  _
2).Value
'Spalte2 oben
Me.txt_Strasse_RG_change.Value = Sheets("Daten").Range("I" & cbo_Firma_RG_change.ListIndex + _
2).Value
Me.txt_Plz_RG_change.Value = Sheets("Daten").Range("J" & cbo_Firma_RG_change.ListIndex + 2). _
Value
Me.txt_Ort_RG_change.Value = Sheets("Daten").Range("K" & cbo_Firma_RG_change.ListIndex + 2). _
Value
Me.txt_Postfach_RG_change.Value = Sheets("Daten").Range("L" & cbo_Firma_RG_change.ListIndex  _
+ 2).Value
'Spalte1 unten
Me.txt_Anrede_RG_change.Value = Sheets("Daten").Range("M" & cbo_Firma_RG_change.ListIndex +  _
2).Value
Me.txt_Titel_RG_change.Value = Sheets("Daten").Range("N" & cbo_Firma_RG_change.ListIndex +  _
2).Value
Me.txt_Vorname_RG_change.Value = Sheets("Daten").Range("O" & cbo_Firma_RG_change.ListIndex + _
2).Value
Me.txt_Name_RG_change.Value = Sheets("Daten").Range("P" & cbo_Firma_RG_change.ListIndex + 2) _
.Value
'Spalte2 unten
Me.txt_Telefon_RG_change.Value = Sheets("Daten").Range("Q" & cbo_Firma_RG_change.ListIndex + _
2).Value
Me.txt_Email_RG_change.Value = Sheets("Daten").Range("R" & cbo_Firma_RG_change.ListIndex +  _
2).Value
Me.txt_Internet_RG_change.Value = Sheets("Daten").Range("S" & cbo_Firma_RG_change.ListIndex  _
+ 2).Value
Me.Lb_erf_Date.Object = Sheets("Daten").Range("D" & cbo_Firma_RG_change.ListIndex + 2). _
Value
Me.Lb_erf_user.Object = Sheets("Daten").Range("W" & cbo_Firma_RG_change.ListIndex + 2). _
Value
'Me.txt_RG_IDgesamt_change.Value = Sheets("Daten").Range("A65000").Value
Me.txt_RG_IDgesamt_change.Value = Application.WorksheetFunction.Count(Range("A2:A65535"))    _
' Ermittle Gesamtanzahl aller Datensätze
Application.ScreenUpdating = False
'aktiviere Buttons
cmd_Adress_RG_change_erease.Enabled = True
cmd_Adress_RG_change_save.Enabled = True
' Setzen des Filters in der Tabelle "Daten_obj", um nur die der angezeigten RG_Adr  _
zugeordneten Obj-Daten anzuzeigen
Worksheets("Daten_obj").Activate
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
If ActiveSheet.FilterMode = False Then
Range("B2:B65535").AutoFilter Field:=2, Criteria1:=Me.txt_ID_RG_change.Value
End If
Application.ScreenUpdating = True
End Sub

Anzeige
AW: von einander abhängige ComboBoxes
26.01.2011 18:31:19
einander
Hallo Michael,
ich geh mal davon aus, dass die Daten in der Tabelle "Daten_RG" eine eindeutige ID haben. Um den Bezug herzustellen, ist diese ID in der Tabelle "Daten_Obj" als Fremdschlüssel aufgeführt.
In meinen Bsp verwende ich ein assoziatives Array "hshObjAddr" (=Dictionary bzw. Hash). Das geht auch mit 'nem "normalen" Array, kostet dann aber wegen "ReDim" mehr Zeit. Bei 40 Datensätzen macht sich das nicht bemerkbar, aber zB. bei 10000.
Siehe Bsp-Datei:
https://www.herber.de/bbs/user/73260.xls
Der Code ohne Fehlerabfangung u.ä:
Option Explicit
Private Sub cboRG_Change()
Dim hshObjAddr As Object
Dim i As Long
Set hshObjAddr = CreateObject("Scripting.Dictionary")
Me.cboObj.Clear
With Sheets("Daten_Obj")
For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
If .Cells(i, 2).Value = Me.cboRG Then
hshObjAddr(i) = .Cells(i, 3).Text
End If
Next
End With
Me.cboObj.List = hshObjAddr.Items
Set hshObjAddr = Nothing
End Sub
Private Sub UserForm_Initialize()
Dim lngLR As Long
With Me.cboRG
.ColumnCount = 2
.ColumnWidths = "0;" & .Width - 12
End With
With Sheets("Daten_RG")
lngLR = .Cells(.Rows.Count, 1).End(xlUp).Row
Me.cboRG.List = .Cells(2, 1).Resize(lngLR - 1, 2).Value
End With
End Sub

Gib mir Bescheid, wie du damit parat kommst
Gruß
Christian
Anzeige
AW: von einander abhängige ComboBoxes
26.01.2011 21:36:51
einander
Hallo Christian,
wow, das sieht schon sehr gut aus. Hab es mal eingebunden und die Spalten an meine angepasst (Cell 5), doch erhalte ich bei "cbo.clear" stets eine Fehlermeldung, daher setzte ich anstelle "clear" . Doch dann gehts weiter mit der Fehlermeldung :
.... auch hier stoppt der Code bei mir
Private Sub cbo_Firma_RG_change_Change()
Dim hshObjAddr As Object
Dim i As Long
Set hshObjAddr = CreateObject("Scripting.Dictionary")
Me.cbo_Firma_obj_change.Value = "" 'clear
With Sheets("Daten_Obj")
For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
If .Cells(i, 2).Value = Me.cbo_Firma_RG_change Then
hshObjAddr(i) = .Cells(i, 5).Text
End If
Next
End With
Me.cbo_Firma_obj_change.List = hshObjAddr.Items
Set hshObjAddr = Nothing
Worksheets("Daten").Activate
Ich hoffe den Knoten dank deiner Hilfe bald gelöst zu haben, das muss doch gehen...! ;-)
Gruß,
Michael
Anzeige
wie schon gesagt, nur ohne RowSource...
27.01.2011 10:14:45
Christian
ich vermute mal, dass du die "cbo_Firma_obj_change" per Rowsource füllst.
Dann tritt bei "clear" ein Fehler auf.
Aber Rowsource brauchst du ja nicht.
Gruß
Christian
AW: wie schon gesagt, nur ohne RowSource...
27.01.2011 22:55:37
Michael
Hallo Christian,
der Hinweis mit den überflüssigen Rowsources war TOP. Aber ich bewege mich nur millimeterweise vorwärts und jetzt habe ich deinen Code mal 1:1 eingebunden, doch meine Tabelle ist etwas anders aufgebaut. So stehen in beiden Tabellen die Adressdaten in Spalte 5 ("E") und ich zweifle nun an mir selbst, das nicht in den BSP-Code von dir einbauen zu können. Kannst du mir folgen und mir das mal richtigstellen? Ich sehe in der cboRG keine Einträge, doch die cboObj zeigt, nachdem ich einfach die die Leereinträge durchgezählt und den entsprechenden Datensatz durch Auswahl des z.B. 6.Leerfeldes in cboRG gewählt habe, die richtigen zugeordnenden Obj-Adressdaten. Oh man aber auch!
Private Sub cboRG_Change()
Dim hshObjAddr As Object
Dim i As Long
Set hshObjAddr = CreateObject("Scripting.Dictionary")
Me.cboObj.Clear
With Sheets("Daten_Obj")
For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
If .Cells(i, 2).Value = Me.cboRG Then
hshObjAddr(i) = .Cells(i, 5).Text         '>>>> hier habe ich Spalte 5 gesetzt,  _
läuft
End If
Next
End With
Me.cboObj.List = hshObjAddr.Items
Set hshObjAddr = Nothing
End Sub
'INITIALISIEREN
Private Sub UserForm_Initialize()
'Routine zum Abfragen der RG-ID für Adressänderungen bei der Auswahl der RG zugehörigen Obj- _
Adresse (quasi Lookup-Funktion)
Dim lngLR As Long
With Me.cboRG
.ColumnCount = 2
.ColumnWidths = "0;" & .Width - 12
End With
With Sheets("Daten")
lngLR = .Cells(.Rows.Count, 1).End(xlUp).Row
Me.cboRG.List = .Cells(2, 1).Resize(lngLR - 1, 2).Value   '>>> und hier verzweifle ich!  _
End With

Anzeige
dann musst du Spalte A und E an cboRG.List ...
28.01.2011 09:30:45
Christian
... übergeben, Micheal (s.u.)
Aber der Code im Initialize Ereignis hat nichts mit der Adressänderung zu tun, sondern füllt lediglich die cboRG mit Daten beim Start der Userform. Beim cboRG_Change Ereignis werden dann die passenden Daten aus "Daten_Obj" in cboObj geschrieben.
(btw - "Me.cboObj.Clear" kannst du löschen, da die cboObj mit "List" gefüllt wird und nicht mit "AddItem")
Gruß
Christian
Private Sub UserForm_Initialize()
Dim lngLR As Long, i As Long
Dim vntRG()
With Me.cboRG
.ColumnCount = 2
.ColumnWidths = "0;" & .Width - 12
End With
With Sheets("Daten_RG")
lngLR = .Cells(.Rows.Count, 1).End(xlUp).Row
ReDim vntRG(lngLR - 2, 1)
For i = 2 To lngLR
vntRG(i - 2, 0) = .Cells(i, 1).Value        'ID_RG
vntRG(i - 2, 1) = .Cells(i, 5).Value        'RG-Adr.
Next
Me.cboRG.List = vntRG
End With
End Sub

Anzeige
AW: dann musst du Spalte A und E an cboRG.List ...
28.01.2011 10:04:40
Michael
Hallo Christian,
TOP!! Ja, das war's! Mensch ich bin dir dankbar, ehrlich!
Da noch viele weiter Herausforderungen in meinem Tool auf mich warten, würde ich mich gern wieder an dich wenden, wenn du magst?
So, Entspannen!
Wünsche dir ein angenehmes Wochenende !
Gruß,
Michael
AW: dann musst du Spalte A und E an cboRG.List ...
29.01.2011 19:50:13
Michael
Hallo Christian,
wie angekündigt... habe festgestellt, dass die cboObj zwar den Fokus auf die Auswahl der cboRG erhält, jedoch zieht sich die cboObj stets die Datensätze ab Zeile 2 in Sheets("Daten_obj"), egal was ich auswähle. Wie muss ich bei der cboObj-Change-Prozedur vorgehen?
Hier mein derzeitiger Code:
Private Sub cboObj_change()
Application.ScreenUpdating = False
With Worksheets("Daten_obj")
Me.txt_info_obj_change.Value = Sheets("Daten_obj").Range("T" & cboObj.ListIndex + 2). _
Value
Me.txt_Internet_obj_change.Value = Sheets("Daten_obj").Range("S" & cboObj.ListIndex + 2) _
.Value
Me.txt_Email_obj_change.Value = Sheets("Daten_obj").Range("R" & cboObj.ListIndex + 2). _
Value
Me.txt_Telefon_obj_change.Value = Sheets("Daten_obj").Range("Q" & cboObj.ListIndex + 2). _
Value
Me.txt_Name_obj_change.Value = Sheets("Daten_obj").Range("P" & cboObj.ListIndex + 2). _
Value
Me.txt_Vorname_obj_change.Value = Sheets("Daten_obj").Range("O" & cboObj.ListIndex + 2). _
Value
Me.txt_Titel_obj_change.Value = Sheets("Daten_obj").Range("N" & cboObj.ListIndex + 2). _
Value
Me.txt_Anrede_obj_change.Value = Sheets("Daten_obj").Range("M" & cboObj.ListIndex + 2). _
Value
Me.txt_Postfach_obj_change.Value = Sheets("Daten_obj").Range("L" & cboObj.ListIndex + 2) _
.Value
Me.txt_Ort_obj_change.Value = Sheets("Daten_obj").Range("K" & cboObj.ListIndex + 2). _
Value
Me.txt_Plz_obj_change.Value = Sheets("Daten_obj").Range("J" & cboObj.ListIndex + 2). _
Value
Me.txt_Strasse_obj_change.Value = Sheets("Daten_obj").Range("I" & cboObj.ListIndex + 2). _
Value
Me.txt_PlzPF_obj_change.Value = Sheets("Daten_obj").Range("H" & cboObj.ListIndex + 2). _
Value
Me.txt_Firma3_obj_change.Value = Sheets("Daten_obj").Range("G" & cboObj.ListIndex + 2). _
Value
Me.txt_Firma2_obj_change.Value = Sheets("Daten_obj").Range("F" & cboObj.ListIndex + 2). _
Value
Me.txt_Firma_obj_change.Text = Sheets("Daten_obj").Range("E" & cboObj.ListIndex + 2). _
Text
Me.txt_ID_obj_change.Value = Sheets("Daten_obj").Range("A" & cboObj.ListIndex + 2). _
Value
' Datensatzanzahl berechnen
Me.txt_obj_IDgesamt_change.Value = Application.WorksheetFunction.Count(Range("A2:A65535" _
))
'Zeilen_sortieren nach Spalte B
Call Data_sort.Sort_Firma_Obj
If cboObj.ListIndex = -1 Or cboObj.Value = "" Then
cmd_Adress_Obj_change_save.Enabled = False
cmd_Adress_Obj_change_erease.Enabled = False
Else
cmd_Adress_Obj_change_save.Enabled = True
cmd_Adress_Obj_change_erease.Enabled = True
End If
End With
Application.ScreenUpdating = True
End Sub

Wäre schön, wenn du mir da wieder einen deiner wertvollen Tipps geben könntest.
Besten Dank im Voraus!
Michael
Anzeige
kann ja so nicht funktionieren...
30.01.2011 10:58:34
Christian
...Michael.
Wenn in der cboObj nur die relevanten Einträge stehen und du zB. den 2. Eintrag auswählst, wird mit :
.Range("T" & cboObj.ListIndex + 2) der Eintrag aus Zeile 3 genommen.
Mein Vorschlag:
gib der cboObj 2 Spalten und schreibe in Spalte 1 die IDs (siehe "ID_Obj" in Spalte A in meiner Bsp-Datei vom 26.01) und in Spalte 2 die Adressen.
Füllen der cboObj dann wie bei cboRG mit 'nem Array.
die relevanten Einträge für deine TextBoxes erhälst du dann zB mit Tabellenfunktion VERGLEICH (Application.Match) oder mit der VBA-Funktion "Find" (siehe vba Hilfe).
Private Sub cboObj_Change()
Dim lngIdx As Long
With Worksheets("Daten_obj")
If Me.cboObj.ListIndex > -1 Then
lngIdx = Application.Match(Me.cboObj, .Columns(1), 0)
Me.txtVorname.Value = .Cells(lngIdx, 15).Value
Me.txtName.Value = .Cells(lngIdx, 16).Value
'Besser wäre: SpaltenNr in Tag-Eigenschaft der TextBox
'schreiben und alle TextBoxes in einer Schleife durchlaufen
End If
End With
End Sub

Gruß
Christian
Anzeige
AW: kann ja so nicht funktionieren...
30.01.2011 13:26:59
Michael
Hallo Christian,
ich muss noch sehr viel lernen. Es ist für mich der Sprung ins kalte Wasser und ich lerne in kleinen Schritten, was du bestimmt erkannt hast. Hab deinen Vorschlag übernommen, erhalte aber noch Fehlermeldung bei Application.Match... : "Typen nicht verträglich":
' Ändern/aufrufen der vorhandenen Obj-Adresse
Private Sub cboObj_Change()
Application.ScreenUpdating = False
Dim lngIdx As Long
With Worksheets("Daten_obj")
If Me.cboObj.ListIndex > -1 Then
    lngIdx = Application.Match(Me.cboObj, .Columns(1), 0)                  _
Me.txt_ID_obj_change.Value = .Cells(lngIdx, 1).Value
Me.txt_Firma_obj_change.Value = .Cells(lngIdx, 5).Value
Me.txt_Firma2_obj_change.Value = .Cells(lngIdx, 6).Value
Me.txt_Firma3_obj_change.Value = .Cells(lngIdx, 7).Value
Me.txt_PlzPF_obj_change.Value = .Cells(lngIdx, 8).Value
Me.txt_Strasse_obj_change.Value = .Cells(lngIdx, 9).Value
Me.txt_Plz_obj_change.Value = .Cells(lngIdx, 10).Value
Me.txt_Ort_obj_change.Value = .Cells(lngIdx, 11).Value
Me.txt_Postfach_obj_change.Value = .Cells(lngIdx, 12).Value
Me.txt_Anrede_obj_change.Value = .Cells(lngIdx, 13).Value
Me.txt_Titel_obj_change.Value = .Cells(lngIdx, 14).Value
Me.txt_Vorname_obj_change.Value = .Cells(lngIdx, 15).Value
Me.txt_Name_obj_change.Value = .Cells(lngIdx, 16).Value
Me.txt_Telefon_obj_change.Value = .Cells(lngIdx, 17).Value
Me.txt_Email_obj_change.Value = .Cells(lngIdx, 18).Value
Me.txt_Internet_obj_change.Value = .Cells(lngIdx, 19).Value
Me.txt_info_obj_change.Value = .Cells(lngIdx, 20).Value
End If
End With
' Datensatzanzahl berechnen
Me.txt_obj_IDgesamt_change.Value = Application.WorksheetFunction.Count(Range("A2:A65535" _
))
'Zeilen_sortieren nach Spalte B
'Call Data_sort.Sort_Firma_Obj
If cboObj.ListIndex = -1 Or cboObj.Value = "" Then
cmd_Adress_Obj_change_save.Enabled = False
cmd_Adress_Obj_change_erease.Enabled = False
Else
cmd_Adress_Obj_change_save.Enabled = True
cmd_Adress_Obj_change_erease.Enabled = True
End If
Application.ScreenUpdating = True
End Sub

Mein Dank an dich ist immens!
Gruß,
Michael
Anzeige
AW: kann ja so nicht funktionieren...
30.01.2011 13:51:21
Michael
Hallo Christian,
hab den Auslöser gefunden: muss Columns(5), 1 lauten, denn der Adressvergleich bezieht sich ja auf Spalte 5.
Juchhee...
Dank trotzdem!
Michael
dann ist cboObj aber nicht 2-spaltig ...
30.01.2011 14:25:56
Christian
...wie von mir vorgeschlagen.
Da du ja in Spalte A von "Daten_obj" eine ID vergibst - und das ist ja durchaus sinnvoll, dann beziehe dich auch auf diese.
Natürlich läuft dein Code jetzt auch so, aber wenn du später die Daten weiter "normalisierst" wirst du darüber stolpern - google mal nach "Datenbank" und "Normalisierung". Natürlich ist Excel keine Datenbank, aber im kleinen Rahmen kann man zumindest eine DB-Struktur aufbauen.
Also: Immer sauber bleiben.
Gruß
Christian

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige