Met meerdere waarden zoeken met VBA

Status
Niet open voor verdere reacties.
S

Slvanbeek1986

Gebruiker
Lid geworden
16 mei 2017
Berichten
6
Beste leden,

Ik kom er helaas niet helemaal uit.
Wanneer ik op een userform de eerste combobox1 een artikelnummer in toets uit kolom A,
dan zou ik graag in combobox2 de resultaten zien van dat artikelnummer uit kolom B.

Om vervolgens in de textbox de omschrijving van kolom C weer te geven.

Bijgaand heb ik voorbeeldbestand gedaan.

Is er iemand die mij hiermee kan en wil helpen?

Bijvoorbaat dank!

Bekijk bijlage Test.xlsm
 
In het Userform.
Code: 
Option Explicit
Dim Dic As Object
Private Sub UserForm_Initialize()
Dim sv, i As Long
sv = Sheets(1).Cells(1).CurrentRegion
 Set Dic = CreateObject("scripting.dictionary")
    For i = 2 To UBound(sv)
      If Not Dic.exists(sv(i, 1)) Then Dic.Item(sv(i, 1)) = Array(sv(i, 1), CreateObject("scripting.dictionary"))
         Dic(sv(i, 1))(1).Item(sv(i, 2)) = Array(Application.Index(sv, i, Array(2, 3)), i)
    Next i
 ComboBox1.List = Dic.keys
End Sub

Private Sub ComboBox1_Change()
 ComboBox2.ListIndex = -1
 ComboBox2.List = Dic(CLng(ComboBox1.Value))(1).keys
 TextBox1 = ""
End Sub


Private Sub ComboBox2_Change()
If ComboBox2.ListIndex > -1 Then
  TextBox1.Value = Dic(CLng(ComboBox1.Value))(1)(ComboBox2.Value)(0)(2)
 End If
End Sub
 
@HSV,

Ik heb belangstelling voor het onderwerp en jouw oplossing maar ik krijg een foutmelding "Sub of Function is niet gedefinieerd" en het woord "Dic" is gemarkeerd.
in deze code :
Code: 
Private Sub ComboBox1_Change()
 ComboBox2.ListIndex = -1
 ComboBox2.List = Dic(CLng(ComboBox1.Value))(1).keys
 TextBox1 = ""
End Sub

Enig idee wat de fout veroorzaakt?
 
Laatst bewerkt:
Dan staat De rode regel niet boven de Private sub, maar in de Private sub.

Goed:
Code: 
[COLOR=#0000ff]Option Explicit [/COLOR]
[COLOR=#ff0000]Dim Dic As Object[/COLOR]
[COLOR=#0000ff]Private Sub UserForm_Initialize()[/COLOR]
Dim sv, i As Long

Fout:
Code: 
[COLOR=#0000ff]Option Explicit[/COLOR]
[COLOR=#0000ff]Private Sub UserForm_Initialize()[/COLOR]
Dim sv, i As Long
[COLOR=#ff0000]Dim Dic As Object[/COLOR]
 
@HSV,

Bedankt voor de info. Declaratie stond op de verkeerde plaats.
 
Of gewoon een Listbox:

Code: 
Private Sub UserForm_Initialize()
  With ListBox1
    .List = Blad1.Cells(1).CurrentRegion.Offset(1).SpecialCells(12).Value
    .ColumnCount = UBound(.List, 2) + 1
    .ColumnWidths = Replace(Space(.ColumnCount), " ", "40;")
  End With
End Sub
 
Bedankt!

Sorry voor mijn late reactie! Maar heel hartelijk bedankt.
Ik ga er zsm mee verder.

Groet
 
@HSV

Bedankt voor de code. Heb hem erin gezet maar blijft een foutcode geven.
Heb jij enig idee wat dit kan zijn? Kom er zelf helaas niet uit.

Bijgaand foto....

Alvast bedankt!

Code-fout.png
 
Goedemorgen snb,

Dit was idd een mooie oplossing geweest als ik weinig gegevens had. Maar in combobox1 komen ongeveer 2500 nummers te staan. En combobox2 komt per nummer verschillend 0, 1, 2 of 3 eigenschappen te staan. En dit moet dan de benaming weergeven in textbox1. Vervolgens wordt deze tekst dan in een cel op het werkblad gezet.

Vandaar mijn keuze voor combobox. Super bedankt in ieder geval voor het meedenken.
 
Laatst bewerkt door een moderator:
Hoi,

In het het bestand wat je plaatste werkt het goed.
Mogelijk staan er in kolom A zowel cijfers als tekst of alleen cijfers.

Oplossing voor bovengenoemde.
Code: 
Option Explicit
Dim Dic As Object
Private Sub UserForm_Initialize()
Dim sv, i As Long
sv = Sheets(1).Cells(1).CurrentRegion
 Set Dic = CreateObject("scripting.dictionary")
    For i = 2 To UBound(sv)
      If Not Dic.exists(CStr(sv(i, 1))) Then Dic.Item(CStr(sv(i, 1))) = Array(CStr(sv(i, 1)), CreateObject("scripting.dictionary"))
         Dic(CStr(sv(i, 1)))(1).Item(sv(i, 2)) = Array(Application.Index(sv, i, Array(2, 3)), i)
    Next i
 ComboBox1.List = Dic.keys
End Sub


Private Sub ComboBox1_Change()
 ComboBox2.ListIndex = -1
 ComboBox2.List = Dic(CStr(ComboBox1.Value))(1).keys
 TextBox1 = ""
End Sub




Private Sub ComboBox2_Change()
If ComboBox2.ListIndex > -1 Then
  TextBox1.Value = Dic(CStr(ComboBox1.Value))(1)(ComboBox2.Value)(0)(2)
 End If
End Sub
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan