Office: (Office 2010) Excel VBA Suche mit Hilfe von Comboboxen in Anhängigkeiten

Hallo

Ich bin unerfahren im Bereich VBA und versuche mich aber grade an einer (für mich) sehr komplexen Aufgabe.
Ich würde gerne eine Suche über eine UserForm mit 4 Comboboxen erstellen. Combobox 1 ist die ausschlaggebende Box. Diese soll dann mit den andern 3 Boxen gekoppelt sein.
Ich habe eine Code gefunden, welchen ich angepasst habe. Ich sehe auch die richtigen Einträge in Combobox 1, da passt dann auch die ListBox dazu. Nur leider tauchen in den andern Boxen nicht die richtigen Einträge ein. Da steht dann leider immer nur "alle" und nicht die Auswahlmöglichkeiten die ich eigentlich haben wollte.
Ich hatte den Code auch so verstanden, das die ListBox sich dann immer wieder individuelle anpasst, leider ist das nicht so, oder ich hab es einfach nicht richtig verstanden. Ich würde mich freuen wenn mir jemand Helfen könnte!

Der Code:

Option Explicit

Const kateg As Integer = 1
Const artikelbez As Integer = 2
Const herst As Integer = 3
Const artnu As Integer = 4

Private b1Event As Boolean

Private Sub cboKategorie_Error(ByVal Number As Integer, ByVal Description As MSForms.ReturnString, ByVal SCode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, ByVal CancelDisplay As MSForms.ReturnBoolean)
MsgBox "Enter"
End Sub


Private Sub UserForm_Initialize()

FuelleListe
FuelleAlleCombos
b1Event = True
End Sub

Private Sub cboKategorie_Change()

If b1Event Then
FuelleListe
FuelleAlleCombos
b1Event = True
End If

End Sub

Private Sub cboHersteller_Change()
If b1Event Then
FuelleListe
FuelleAlleCombos
End If

End Sub

Private Sub cboArtikelbez_Change()
If b1Event Then
FuelleListe
FuelleAlleCombos
End If

End Sub

Private Sub cboArtNummer_Change()
If b1Event Then
FuelleListe
FuelleAlleCombos
End If

End Sub

Private Sub Button_Abruch_Click()

Unload SuchenFinden

End Sub

Private Sub FuelleAlleCombos()

b1Event = False
FuelleComboAusTabelle cboKategorie, ActiveSheet, kateg
FuelleComboAusListe cboHersteller, herst
FuelleComboAusListe cboArtikelbez, artikelbez
FuelleComboAusListe cboArtNummer, artnu
b1Event = True

End Sub


Private Sub FuelleComboAusListe(ByVal Combo As Object, ByVal Spalte As Integer)

Dim iRow As Long, arWerte() As Variant, col As New Collection, strTmp As String

b1Event = False
strTmp = Combo.Value
arWerte = ListBox1.List

On Error Resume Next
Combo.Clear
Combo.AddItem "alle"
For iRow = 0 To UBound(arWerte)
col.Add arWerte(iRow, Spalte - 1), arWerte(iRow, Spalte - 1)
If Err = 0 Then
Combo.AddItm arWerte(iRow, Spalte - 1)
Else
Err.Clear
End If
Next iRow
On Error GoTo 0

Combo.Value = strTmp

Set col = Nothing
b1Event = True

End Sub



Private Sub FuelleComboAusTabelle(ByVal Combo As Object, ByVal Ws As Worksheet, ByVal Spalte As Integer)

Dim iRow As Long, arWerte() As Variant, col As New Collection, strTmp As String

b1Event = False
strTmp = Combo.Value

With Ws
iRow = IIf(IsEmpty(.Cells(.Rows.Count, kateg)), .Cells(.Rows.Count, kateg).End(xlUp).Row, .Rows.Count)
arWerte = .Range(.Cells(6, Spalte), .Cells(iRow, Spalte)).Value

On Error Resume Next
Combo.Clear
Combo.AddItem "alle"
For iRow = 2 To UBound(arWerte, 1)
col.Add arWerte(iRow, 1), arWerte(iRow, 1)
If Err = 0 Then
Combo.AddItem arWerte(iRow, 1)
Else
Err.Clear
End If
Next iRow
On Error GoTo 0
End With

Combo.Value = strTmp

Set col = Nothing
b1Event = True

End Sub

Private Sub FuelleListe()

Dim strkateg As String, strartikelbez As String, strherst As String, strartnu As String
Dim arWerte As Variant, lngZeile As Long, Spalte As Integer

b1Event = False

ListBox1.Clear

strkateg = IIf(cboKategorie.Value = "alle", "", cboKategorie.Value)
strartikelbez = IIf(cboArtikelbez.Value = "alle", "", cboArtikelbez.Value)
strherst = IIf(cboHersteller.Value = "alle", "", cboHersteller.Value)
strartnu = IIf(cboArtNummer.Value = "alle", "", cboArtNummer.Value)

lngZeile = IIf(IsEmpty(Cells(Rows.Count, kateg)), Cells(Rows.Count, kateg).End(xlUp).Row, Rows.Count)
arWerte = Range(Cells(6, 1), Cells(lngZeile, Cells.SpecialCells(xlCellTypeLastCell).Column)).Value

For lngZeile = 1 To UBound(arWerte, 1)
If arWerte(lngZeile, kateg) = strkateg Or strkateg = "" Then
If arWerte(lngZeile, artikelbez) = strartikelbez Or strartikelbez = "" Then
If arWerte(lngZeile, herst) = strherst Or strherst = "" Then
If arWerte(lngZeile, artnu) = strartnu Or strartnu = "" Then
ListBox1.AddItem arWerte(lngZeile, 1)
For Spalte = 2 To UBound(arWerte, 2)
ListBox1.List(ListBox1.ListCount - 1, Spalte - 1) = arWerte(lngZeile, Spalte)
Next
End If
End If
End If
End If
Next

b1Event = True
End Sub


Vielen lieben Dank

 

Hallo,

das Problem liegt an dem fehlenden "e", unten rot dargestellt:

Code:

Private Sub FuelleComboAusListe(ByVal Combo As Object, ByVal Spalte As Integer)

Dim iRow As Long, arWerte() As Variant, col As New Collection, strTmp As String

b1Event = False
strTmp = Combo.Value
arWerte = ListBox1.List

On Error Resume Next
Combo.Clear
Combo.AddItem "alle"
For iRow = 0 To UBound(arWerte)
col.Add arWerte(iRow, Spalte - 1), arWerte(iRow, Spalte - 1)
If Err = 0 Then
Combo.AddIt[COLOR="#FF0000"][B]e[/B][/COLOR]m arWerte(iRow, Spalte - 1)
Else
Err.Clear
End If
Next iRow
On Error GoTo 0

Combo.Value = strTmp

Set col = Nothing
b1Event = True

End Sub

 

Hallo Anton Exl

Vielen Lieben Dank, es funktioniert! Ich habe alles 5 mal kontrolliert, aber diese fehlende e ist mir nie aufgefallen!

Einen schönen Tag und bleib Gesund

 

Hallo

Ich hoffe das mir noch einmal jemand Helfen kann.

Ich habe den Code von Oben noch einmal geändert. Aber ich bekomme es leider nicht hin, dass der Command Button mir ein Ergebnis anzeigt. Es Wäre schön, wenn dir Zeile in der Produkt steht Markiert ist. Aber nicht durch eine Farbe oder ähnliches, sondern nur das der Cursor sich an der Stelle befindet.

Anbei noch einmal der Code mit dem Such Button der leider nicht funktioniert:



Option Explicit

'Modulweite Variablen deklarieren

Const C_mstrDatenblatt As String = "Verbrauchsmaterial"

Dim mobjDic As Object
Dim mlngLast As Long
Dim mlngZ As Long



Private Sub cboKategorie_Enter()

'Erste Combobox. Jedes Land in Spalte A wird einmalig angezeigt

Set mobjDic = CreateObject("Scripting.Dictionary")

For mlngZ = 6 To mlngLast

mobjDic(Worksheets(C_mstrDatenblatt).Cells(mlngZ, 1).Value) = 0

Next

Me.cboKategorie.List = mobjDic.keys

Set mobjDic = Nothing

End Sub

Private Sub cboHersteller_Enter()

'Zweite Combobox in Abhängigkeit von Combobox1.

'Jeder passende Stadt in Spalte B wird einmalig angezeigt.

Set mobjDic = CreateObject("Scripting.Dictionary")

With Worksheets(C_mstrDatenblatt)

For mlngZ = 6 To mlngLast

If .Cells(mlngZ, 1).Value = Me.cboKategorie.Value Then

mobjDic(.Cells(mlngZ, 3).Value) = 0

End If

Next

End With

Me.cboHersteller.List = mobjDic.keys

Set mobjDic = Nothing

End Sub

Private Sub cboArtikelbez_Enter()

'Dritte Combobox in Abhängigkeit von Combobox 1 + 2.

Me.cboArtikelbez.Clear

With Worksheets(C_mstrDatenblatt)

For mlngZ = 6 To mlngLast

If .Cells(mlngZ, 1).Value = Me.cboKategorie.Value And .Cells(mlngZ, 3).Value = Me.cboHersteller.Value Then

Me.cboArtikelbez.AddItem .Cells(mlngZ, 2).Value

End If

Next

End With

End Sub

Private Sub cboArtNummer_Enter()

'Dritte Combobox in Abhängigkeit von Combobox 1 + 2.

Me.cboArtNummer.Clear

With Worksheets(C_mstrDatenblatt)

For mlngZ = 6 To mlngLast

If .Cells(mlngZ, 1).Value = Me.cboKategorie.Value And .Cells(mlngZ, 3).Value = Me.cboHersteller.Value And .Cells(mlngZ, 2).Value = Me.cboArtikelbez.Value Then

Me.cboArtNummer.AddItem .Cells(mlngZ, 4).Value

End If

Next

End With

End Sub


Private Sub Button_Abruch_Click()

'Userform schliessen

Unload Me

End Sub

Private Sub Button_Suche_Click()

Dim mlngZ2 As String

mlngZ2 = mlngZ

With Worksheets(C_mstrDatenblatt)

If mlngZ2 Is Nothing Then
MsgBox "Ware nicht bekannt!"
Else
mlngZ2.Select
End If

End With

Unload Me

End Sub


Private Sub UserForm_Initialize()

'Bei Start der Userform wird die unterste Zeile in Spalte A ermittelt

mlngLast = Worksheets(C_mstrDatenblatt).Cells(Rows.Count, 1).End(xlUp).Row

End Sub


Vielen Dank

 

Hallo

Leider hab ich zu dem gleichen Thema einen neues Problem.
Ich habe den Code abgeändert, auch dieser Code funktionier soweit. Nur leider bekomm ich den CommandButton für die Suche nicht Programmiert.
Ich hätte gerne, das nur die Zeile in einer MsgBox angezeigt wird und die Zeile vom Cursor markiert wird. Leider zeigt er mir nicht mal die richtige Zeile in der MsgBox an. Ich hab jetzt schon ewig viele Varianten Probiert und verzweifle langsam.

Anbei der Code mit dem nicht Funktionierenden Such Button:

Option Explicit

'Modulweite Variablen deklarieren

Const C_mstrDatenblatt As String = "Verbrauchsmaterial"

Dim mobjDic As Object
Dim mlngLast As Long
Dim mlngZ As Long



Private Sub cboKategorie_Enter()

'Erste Combobox. Jedes Land in Spalte A wird einmalig angezeigt

Set mobjDic = CreateObject("Scripting.Dictionary")

For mlngZ = 6 To mlngLast

mobjDic(Worksheets(C_mstrDatenblatt).Cells(mlngZ, 1).Value) = 0

Next

Me.cboKategorie.List = mobjDic.keys

Set mobjDic = Nothing

End Sub

Private Sub cboHersteller_Enter()

'Zweite Combobox in Abhängigkeit von Combobox1.

'Jeder passende Stadt in Spalte B wird einmalig angezeigt.

Set mobjDic = CreateObject("Scripting.Dictionary")

With Worksheets(C_mstrDatenblatt)

For mlngZ = 6 To mlngLast

If .Cells(mlngZ, 1).Value = Me.cboKategorie.Value Then

mobjDic(.Cells(mlngZ, 3).Value) = 0

End If

Next

End With

Me.cboHersteller.List = mobjDic.keys

Set mobjDic = Nothing

End Sub

Private Sub cboArtikelbez_Enter()

'Dritte Combobox in Abhängigkeit von Combobox 1 + 2.

Me.cboArtikelbez.Clear

With Worksheets(C_mstrDatenblatt)

For mlngZ = 6 To mlngLast

If .Cells(mlngZ, 1).Value = Me.cboKategorie.Value And .Cells(mlngZ, 3).Value = Me.cboHersteller.Value Then

Me.cboArtikelbez.AddItem .Cells(mlngZ, 2).Value

End If

Next

End With

End Sub

Private Sub cboArtNummer_Enter()

'Dritte Combobox in Abhängigkeit von Combobox 1 + 2.

Me.cboArtNummer.Clear

With Worksheets(C_mstrDatenblatt)

For mlngZ = 6 To mlngLast

If .Cells(mlngZ, 1).Value = Me.cboKategorie.Value And .Cells(mlngZ, 3).Value = Me.cboHersteller.Value And .Cells(mlngZ, 2).Value = Me.cboArtikelbez.Value Then

Me.cboArtNummer.AddItem .Cells(mlngZ, 4).Value

End If

Next

End With

End Sub


Private Sub Button_Abruch_Click()

'Userform schliessen

Unload Me

End Sub

Private Sub Button_Suche_Click()

Dim mlngZ2 As String

mlngZ2 = mlngZ

With Worksheets(C_mstrDatenblatt)

If mlngZ2 Is Nothing Then
MsgBox "Ware nicht bekannt!"
Else
mlngZ2.Select
End If

End With

Unload Me

End Sub


Private Sub UserForm_Initialize()

'Bei Start der Userform wird die unterste Zeile in Spalte A ermittelt

mlngLast = Worksheets(C_mstrDatenblatt).Cells(Rows.Count, 1).End(xlUp).Row

End Sub

Vielen lieben Dank

 

Hallo,

es ist sinnlos, den Wert der Schleifen-Laufvariable "mlngZ" anzuzeigen, nachdem sie mit "For mlngZ=6 to mlngLast …. Next" eine Schleife durchlaufen ist. Es ist klar, dass sie dann den Wert mlngLast+1 haben muss und somit auf die 1.Zeile nach der Suchtabelle zeigt.

Da du offenbar meine Anmerkungen im VBA-Code, dass die DropDown-Liste der cboArtNummer-Combobox 2-spaltig ist (und in der 2.Spalte die Zeilennummer der ausgewählten Artikelnummer enthalten ist, die mittels "Button_Suche_Click" abgefragt wird), in der Userform nicht übernommen hast, habe ich die entsprechenden Eigenschaftseinstellungen explizit in den Code aufgenommen:

Code:

   Dim cboA As MSForms.ComboBox
   Set cboA = Me.cboArtnummer
   With cboA
      .Clear
      .ColumnCount = 2
      .BoundColumn = 2
      .ColumnWidths = "2cm;0,5cm"
      .ListWidth = "3,0cm"
   End With

Ich habe die Anzeige in der MsgBox umgestellt, dass statt der Zelladresse die gefundene Zeilennummer angezeigt wird. Weiters wird jetzt nicht die gesamte gefundene Zeile im Arbeitsblatt markiert, sondern nur die 4 Zellen in der Tabelle. Falls nur die Zelle mit der gefundenen Artikelnummer markiert werden soll, ist der VBA-Code wie folgt abzuändern:

Code:

   lngZeile = Me.cboArtnummer.Value
   With Worksheets(C_mstrDatenblatt)
      Set mobjDic = [B][COLOR="#0000CD"].Cells(lngZeile, 4)[/COLOR][/B]
      MsgBox "Gefunden in Zeile " & lngZeile '  mobjDic.Address
      [B][COLOR="#0000FF"]mobjDic.Select[/COLOR][/B]                         '  mobjDic.EntireRow.Select
   End With

Nachfolgend nochmals die Excel-Datei:

 

Vielen Dank, jetzt Funktioniert es