Opgelost Gegevens filteren

[Georgyboy]

Goeiedag,

Heb samen met grotendeel de hulp van ChatGpt een VBA code welke wel werkt.
Kunnen we deze code inkorten? zo ja hoe?
zelf heb ik een stukje code tussen gevoegd tussen Witch en End Witch, dit bij wijze om zelf te leren.

Heb een tabel Tabblad "Data" waar in kolom "A" alle artikels staan
In de andere kolommen staan andere gegevens als:
Kolom "B" naam
Kolom "E" partij, Kolom "F" aantal, kolom "G" Gewicht

in Tabblad "Data" kolom "A" staan duizenden artikels en per artikel zijn er meerdere gegevens.


In kolom "A" van tabblad "Data" bevat 3210 regels waarvan 348 unieke waarden
In tabblad "Selectie" staan 9 waarden als filter uit kolom "A" van tabblad "Data"
In tabblad "Gefilterde Data" graag de geselectererde gegevens

Eigenlijk komt het er op neer om in tabblad "Data" een filter te plaatsen en filteren in Kolom "A"
en daar deze 9 gegevens te selecteren
192000
85002000
74100
173000
85413000
85414000
130000
120000
193000

 

[AHulpje]

Tsja, AI...

Sub ZonderChatGPT()
    Sheets("Data").Activate
    arr = Sheets("Selectie").UsedRange
    ReDim a(UBound(arr) - 1) As String
    For i = 0 To UBound(arr) - 1
        a(i) = arr(i + 1, 1)
    Next
    With ActiveSheet.ListObjects("Query1").Range
        .AutoFilter Field:=1, Criteria1:=a, Operator:=xlFilterValues
        .SpecialCells(xlCellTypeVisible).Copy Sheets("Gefilterde Data").Range("A1")
    End With
End Sub

 

[peter59]

Als je power query goed doet gebruiken dus ook v.w.b. het uploaden naar power query dan heb je geen VBA nodig.
Of zie ik iets over het hoofd?

 

[snb]

Aiaiai, quel malheur.

zet boven de criteria 'Plunum' en gebruik:

Sub M_snb()
   Blad1.ListObjects(1).Range.AdvancedFilter 2, Blad4.UsedRange, Blad7.Cells(40, 1)
End Sub

Advancedfilter is een van de onbekendste pareltjes in Excel.
Trek eens een middag uit om alle mogelijkheden van advancedfilter systematisch te ontdekken.

@peter59 je ziet advancedfilter over het hoofd (of welke ander lichaaamsdeel dan ook).

 

[HSV]

Heel mooi @snb,

Ook maar een duit zonder loop, al dan niet om van te leren.

Sub hsv()
 With Sheets("data").ListObjects(1).DataBodyRange
  .AutoFilter 1, Split(Join(Application.Transpose(Sheets("selectie").Cells(1).CurrentRegion), "|"), "|"), 7
  .Offset(-1).Copy Sheets("gefilterde data").Cells(1)
  .AutoFilter
 End With
End Sub

 

[peter59]

@AHulpje, Snb, Hsv
Waarom "moeilijk" doen als het met power query kan.
TS heeft de eerste aanzet al gegeven met power query en wil het e.e.a. door middel van VBA gaan filteren.

Dat zit gewoon ingebakken in power query. Zie #3

 

[HSV]

Of ik nu op 'vernieuwen' of op een knopje moet drukken is lood om oud ijzer.

 

[peter59]

@HSV
Aanname is dat deze opmerking van jou aan mij is gericht.
Zoals je in bovenstaande afbeelding kunt zien is TS al in de weer geweest om beide tabellen met power query in te laden.
Het is nu voor TS alleen een kwestie om éénmalig de 2 query's samen te voegen. Dus geen knopje drukken en niks vernieuwen.

 

[Georgyboy]

Mag ik jullie danken voor alle beter werkende oplossingen!

Aiaiai, quel malheur. (Als ik de geboden oplossingen nu zie, inderdaad)

Versteld hoe kort een goed werkende code kan zijn.
Bedankt dat ik van jullie steeds mag leren zowel in Excel, VBA, Power Query en zoveel meer.....

Sorry dat ik ook curieus ben en ook van de nieuwe technologie wil leren, helpt soms, meestal handig om de uitleg van hoe een code werkt te vragen.
Dit helpt me wederom en hoop ook dat anderen er iets aan hebben met de geboden oplossingen van jullie.

Had zelf volgende melding:
De bewerking die u gaat uitvoeren is van invloed op een groot aantal cellen en kan erg lang duren. Weet u zeker dat u wilt doorgaan?Opmerking: deze bewerking wordt over 60 seconden automatisch uitgevoerd als er geen reactie wordt ontvangen.

Hartelijk dank!
Groeten, Georgyboy

 

[Warme bakkertje]

En zo met de juiste opmaak en zonder enige flikkering van je scherm.

Sub tst()
    Application.ScreenUpdating = False
    With Blad7
        .Cells(1).CurrentRegion.Offset(1).ClearContents
        Blad1.Cells(1).CurrentRegion.AdvancedFilter 2, Blad4.Cells(1).CurrentRegion, .Cells(1).CurrentRegion
        With .Range("E2:E" & .Cells(.Rows.Count, 5).End(xlUp).Row)
            .NumberFormat = "0.00"
            .Offset(, 1).NumberFormat = "0 ""kg"""
        End With
    End With
    Application.ScreenUpdating = True
End Sub

 

[Georgyboy]

Verwend tot en met aan wat heb ik dit verdiend, toch zeker niet met mijn charmes

 

[emields]

vergeet niet uw vraag als opgelost te zetten.