Hoe Dynamisch een filter opbouwen

Status
Niet open voor verdere reacties.

HansFRAP

Gebruiker
Lid geworden
12 jul 2011
Berichten
209
Probleem
Ik heb 2 werkbladen.
Het eerste is gevuld met DATA, het tweede bevat een tabel tbv filtering van de DATA.
Nu kan het Filter bestaan uit een variabel aantal filterwaardes. Deze waardes staan in een tabel, A2:A... (max 50)

Als ik met de recorder de macro opneem ontstaat:
Range("D5").Select
ActiveSheet.Range("$A$5:$CK$6677").AutoFilter Field:=4, Criteria1:=Array("Jan", "Piet", "Klaas", "Joke"), Operator:= xlFilterValues

Nu zou ik graag de waarde tussen de Array-haken uit de tabel van Blad2, A2:A32 halen (als voorbeeld).

Vraag
Hoe kan ik de array dynamisch vullen met de waardes uit de Filter-tabel?

Gezocht om een waarde op te bouwen met de filtertabel waardes maar dan ontstaat er een foutmelding
Dit had de vorm:
Dim Filterwaarde
Sheets("Blad2").Select
Range("A1").Select
for x = 1 to LastRowF
Filterwaarde = Filterwaarde & Activecell.offset(x,0),value & ", "
next x
Sheets("Blad2").Select
Range("D5").Select
ActiveSheet.Range("$A$5:$CK$6677").AutoFilter Field:=4, Criteria1:=Array(Filterwaarde), Operator:= xlFilterValues

Boem!

Hoe moet dit wel??
 
Het filter dat je nu opbouwt zal er als volgt uit zien:
"Jan, Piet, Klaas, Joke"

Terwijl het dit moet zijn:
"Jan", "Piet", "Klaas", "Joke"

Je moet dus bij het maken van het filter ook zorgen dat de afzonderlijke waarden tussen dubbele quotes staan.
 
Zoiets dus:
Code:
For x = 1 To LastRowF
     If Not Filterwaarde = "" Then Filterwaarde = Filterwaarde & ", "
     Filterwaarde = Filterwaarde & """" & Activecell.offset(x,0),value & """"
Next x
 
Hiermee zou je een eind moeten komen:

Code:
ActiveSheet.Range("$D$5:$D$6677").AutoFilter 1, [transpose(Blad2!A2:A32)], 7
 
Dank voor de tips.
Probleem wat Edmoor aangeeft had ik reeds gezien, met de oplossing van OctaFish moet ik daar wel uitkomen.
Daarnaast voorstel van SNB is wel lekker compact.
Met deze hulp moet het weer gaan lukken, mijn dank.
 
Oplossing is gevonden.

- In de oplossing van EdMoor en OctaFish ontstaat een variabele die waardes krijgt die ook tussen aanhalingstekens staan.
Echter het totale resultaat blijft een string.
Resultaat string: ""Jan", "Piet", "Klaas", "Joke""

Oplossingscode:

Sub FilterStukje
Dim FilterArray()
Sheets("Blad2").Select
Range("A1").Select
With ActiveSheet
LastRowRTeam = .Cells(.Rows.Count, ConvertToLetter(ActiveCell.Column)).End(xlUp).Row 'ConvertToLetter aparte functie
End With
ReDim FilterArray(1 To LastRowRTeam)
For x = 1 To LastRowRTeam
FilterArray(x) = ActiveCell.Offset(x, 0).Value
Next x
Sheets("Blad1").Select
Range("D5").Select
'Selection.AutoFilter wordt met onderstaande automatisch gezet
ActiveSheet.Range("$A$5:$CK$6677").AutoFilter Field:=4, Criteria1:=FilterArray, Operator:=xlFilterValues
End sub
 
SNB, ik snap je vraag niet. Code tags? Code is toch opgenomen?

Mijn vraag is opgelost. ik heb deze gevonden met behulp van de verkregen tips.
 
Ok, poging om code van tekst te onderscheiden:
Oplossing is gevonden.

- In de oplossing van EdMoor en OctaFish ontstaat een variabele die waardes krijgt die ook tussen aanhalingstekens staan.
Echter het totale resultaat blijft een string.
Resultaat string: ""Jan", "Piet", "Klaas", "Joke""
Het moet echter een Array zijn.

Oplossingscode:

Code:
Sub FilterStukje
Dim FilterArray()
  Sheets("Blad2").Select
  Range("A1").Select
  With ActiveSheet
    LastRowRTeam = .Cells(.Rows.Count, ConvertToLetter(ActiveCell.Column)).End(xlUp).Row            'ConvertToLetter aparte functie
  End With
  ReDim FilterArray(1 To LastRowRTeam)
  For x = 1 To LastRowRTeam
    FilterArray(x) = ActiveCell.Offset(x, 0).Value
  Next x
  Sheets("Blad1").Select
  Range("D5").Select
    'Selection.AutoFilter wordt met onderstaande automatisch gezet
  ActiveSheet.Range("$A$5:$CK$6677").AutoFilter Field:=4, Criteria1:=FilterArray, Operator:=xlFilterValues
End sub
 
Maak geen gebruik van select is meestal nergens voor nodig. Waarschijnlijk is dit wel voldoende

Code:
Sub VenA()
  ar = Sheets("Blad2").Range("A2:A" & Sheets("Blad2").Cells(Rows.Count, 1).End(xlUp).Row)
  Sheets("Blad1").Cells(5, 1).CurrentRegion.AutoFilter 4, Application.Transpose(Application.Index(ar, 0, 0)), xlFilterValues
End Sub

Nb.
Met het geavanceerde filter kan het met 1 regel code.
Code:
Sub VenA()
  Sheets("Blad1").Cells(5, 1).CurrentRegion.AdvancedFilter 1, Sheets("Blad2").Cells(1).CurrentRegion
End Sub
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan