Zoeken door middel van macro

[MarcVanloffelt]

Beste experts,

even het probleem schetsen

in blad 1 heb ik een lijst met opdrachtnummers met daarachter "aktionen".

Nu zou ik in blad 2 een macro willen plaatsen waar ze een aktion (nummer) kunnen ingeven en alle opdrachtnummers zoeken in blad 1 die deze aktion hebben en in een lijst weergeven op blad 2 (cel A4). Met filters krijg ik het niet klaar omdat de aktion in verschillende kolommen kan voorkomen.

In bijlage het bestandje

Alvast bedankt
Marc

 

[AD1957]

Maak van Blad1 een tabel

 

[VenA]

Met het geavanceerde filter.

 

[MarcVanloffelt]

Dank je wel VenA, is alvast de juiste richting.

Maar in plaats van te filteren op aktion moet ik filteren op een nummer die in het werkblad staat (zitten tot 300 verschillende nummers onder).

Bv cel D158: 0670017335

Als ik dan 0670017335 ingeef in het veld wil ik alle opdrachtnummers zien die deze aktion ook hebben

Groeten

 

[emields]

Bedoel je zoiets?

 

[MarcVanloffelt]

Heel goed op weg :thumb:, alleen stopt hij nog bij 1.000

Als ik 1380019114 ingeef vind ik er meer dan 1.500, in de lijst stopt ie bij 1.000

Alvast bedankt

 

[AD1957]

Zou dit het soms veroorzaken:shocked:

[COLOR="#FF0000"][a1000[/COLOR]].End(xlUp).Offset(1) = c.Offset(, -k).Value

 

[emields]

Als er zo veel zijn werk je betermet een dictionaiy maar dat gaat mijn petje te boven, dit is wel een oplossing

 

[VenA]

Als een Dictionary te moeilijk is kan het ook zonder. Is inderdaad wel een lastig object om te begrijpen.

Sub VenA()
  ar = Sheets("Blad1").Cells(1).CurrentRegion
  For j = 2 To UBound(ar)
    For jj = 2 To UBound(ar, 2)
      If ar(j, jj) = "" Then Exit For
      If CStr(ar(j, jj)) = CStr(Range("B1")) Then c00 = c00 & "|" & ar(j, 1)
    Next jj
  Next j
  x = Split(Mid(c00, 2), "|")
  Range("A4:A" & Application.Max(4, Cells(Rows.Count, 1).End(xlUp).Row)).Clear
  Range("A4").Resize(UBound(x) + 1) = Application.Transpose(x)
End Sub

Met

Sub VenA()
  ar = Sheets("Blad1").Cells(1).CurrentRegion
  With CreateObject("Scripting.Dictionary")
    For j = 2 To UBound(ar)
      For jj = 2 To UBound(ar, 2)
        If ar(j, jj) = "" Then Exit For
        If CStr(ar(j, jj)) = CStr(Range("B1")) Then .Item(ar(j, 1)) = ""
      Next jj
    Next j
    Range("A4:A" & Application.Max(4, Cells(Rows.Count, 1).End(xlUp).Row)).Clear
    Range("A4").Resize(.Count) = Application.Transpose(.keys)
  End With
End Sub

 

[emields]

Nu heb je keuze genoeg

bijgevoegd het bestand met de drie mogelijke keuzen, onder de knop staat een timer en zal je zien dat mijn voorbeeld een voetganger is en die van VenA straaljagers zijn

 

[VenA]

@emields, Wat is 4 seconden op een mensenleven? Zet in jouw code eens Application.ScreenUpdating = False dan wordt het al een heeeeeeeeeeeeel stuk sneller. :d

 

[emields]

Inderdaad het is nu een snelwandelaar geworden tegen straaljagers

 

[MarcVanloffelt]

Werken echt allemaal super!! Bedankt allemaal!

Nog één vraagje; als ik ook nog een tweede (nog in te voegen kolom B) wil tonen als resultaat, wat verandert er dan in de code? Dus beginnen zoeken in kolom C en kolom A en B tonen

 

[emields]

zo.

 

[MarcVanloffelt]

Schitterend! Nogmaals bedankt allemaal!

Opgelost, dus dit topic mag gesloten worden

 

[AD1957]

Zet de vraag dan als opgelost

 

[VenA]

Sub VenA()
  ar = Sheets("Blad1").Cells(1).CurrentRegion
  With CreateObject("Scripting.Dictionary")
    For j = 2 To UBound(ar)
      For jj = 2 To UBound(ar, 2)
        If ar(j, jj) = "" Then Exit For
        If CStr(ar(j, jj)) = CStr(Range("B1")) Then .Item(ar(j, 1)) = Array(ar(j, 1), ar(j, 2))
      Next jj
    Next j
    Range("A4:B" & Application.Max(4, Cells(Rows.Count, 1).End(xlUp).Row)).Clear
    Range("A4").Resize(.Count, 2) = Application.Index(.items, 0, 0)
  End With
End Sub