• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Samenvoegen functie

Status
Niet open voor verdere reacties.
W

wacco

Gebruiker
Lid geworden
9 mrt 2006
Berichten
229
Hallo,
Ik heb een userform, waar d.m.v. checkboxen een filterkeuze maak.
Ik heb 3 verschillende keuze van filtering, allen met dezelfde code en ook ieder met een aparte startknop.
Graag zou ik deze 3 willen samenvoegen, en willen starten met een en dezelfde startknop.
Enigste verschil tussen de 3 soorten filtering, is de regel : Field:=1,
De andere waarden zijn: Field:=12, en : Field:=14,
Hier het gedeelte code van de filtering:
Code: 
Private Sub cmdFilter_Functie_Click()

 On Error Resume Next
    Dim cChk As Control, arrVals() As Variant, i As Integer
    'Unload Me
    Me.Hide
        For Each cChk In Me.grpFilter.Controls
        i = i + 1
    If cChk.Value = True Then
        ReDim Preserve arrVals(i)
        arrVals(i) = cChk.Tag
    End If

    Next cChk
         ActiveSheet.Range("A15").CurrentRegion.AutoFilter _
         Field:=1, _
         Criteria1:=Array(arrVals), _
         Operator:=xlFilterValues

 
 On Error GoTo 0

End Sub

Private Sub cmdFilter_Ranking_Click()

 On Error Resume Next
    Dim cChk As Control, arrVals() As Variant, i As Integer
    'Unload Me
    Me.Hide
        For Each cChk In Me.grpFilter2.Controls
        i = i + 1
    If cChk.Value = True Then
        ReDim Preserve arrVals(i)
        arrVals(i) = cChk.Tag
    End If

    Next cChk
         ActiveSheet.Range("A15").CurrentRegion.AutoFilter _
         Field:=12, _
         Criteria1:=Array(arrVals), _
         Operator:=xlFilterValues

 
 On Error GoTo 0
End Sub

Private Sub cmdFilter_Wettelijk_Click()

 On Error Resume Next
    Dim cChk As Control, arrVals() As Variant, i As Integer
    'Unload Me
    Me.Hide
        For Each cChk In Me.grpFilter3.Controls
        i = i + 1
    If cChk.Value = True Then
        ReDim Preserve arrVals(i)
        arrVals(i) = cChk.Tag
    End If

    Next cChk
         ActiveSheet.Range("A15").CurrentRegion.AutoFilter _
         Field:=14, _
         Criteria1:=Array(arrVals), _
         Operator:=xlFilterValues

 
 On Error GoTo 0
End Sub

Hopelijk kan iemand mij helpen.
 
Je maakt (of behoudt) EEN knop en plakt daarin alle drie de codes.

Dat komt er ongeveer ZO uit te zien:

Code: 
Private Sub Nieuwe_Knop()
 On Error Resume Next
    Dim cChk As Control, arrVals() As Variant, i As Integer
    'Unload Me
    Me.Hide
        For Each cChk In Me.grpFilter.Controls
        i = i + 1
    If cChk.Value = True Then
        ReDim Preserve arrVals(i)
        arrVals(i) = cChk.Tag
    End If

    Next cChk
         ActiveSheet.Range("A15").CurrentRegion.AutoFilter _
         Field:=1, _
         Criteria1:=Array(arrVals), _
         Operator:=xlFilterValues

 
 On Error GoTo 0

End Sub

Private Sub cmdFilter_Ranking_Click()

 On Error Resume Next
    Dim cChk As Control, arrVals() As Variant, i As Integer
    'Unload Me
    Me.Hide
        For Each cChk In Me.grpFilter2.Controls
        i = i + 1
    If cChk.Value = True Then
        ReDim Preserve arrVals(i)
        arrVals(i) = cChk.Tag
    End If

    Next cChk
         ActiveSheet.Range("A15").CurrentRegion.AutoFilter _
         Field:=12, _
         Criteria1:=Array(arrVals), _
         Operator:=xlFilterValues

 
 On Error GoTo 0
End Sub

Private Sub cmdFilter_Wettelijk_Click()

 On Error Resume Next
    Dim cChk As Control, arrVals() As Variant, i As Integer
    'Unload Me
    Me.Hide
        For Each cChk In Me.grpFilter3.Controls
        i = i + 1
    If cChk.Value = True Then
        ReDim Preserve arrVals(i)
        arrVals(i) = cChk.Tag
    End If

    Next cChk
         ActiveSheet.Range("A15").CurrentRegion.AutoFilter _
         Field:=14, _
         Criteria1:=Array(arrVals), _
         Operator:=xlFilterValues

 
 On Error GoTo 0
End Sub

Maar de LAATSTE filtering wordt zichtbaar, dus dat bedoel je vast niet. Ik gok dat je bedoeld dat na klikken op die knop kunt kiezen...

Dan kun je bv drie modules apart maken, zoal je nu hebt, en daarin verwijzen in bv een ComBoBox met als keuze de namen van de drie modules...

Anders graag een voorbeeldbestandje plaatsen...
 
Dankje voor de snelle reactie.
Maar dit is niet wat ik bedoel, ik wil willekeurig elke optie (checkbox) willen kiezen en daarop kunnen filteren.
Omdat deze checkboxen zijn onderverdeelt in 3 groepen, met de daarbij behorende kolom, moet ik voor elke groep een aparte cmd knop gebruiken.
Dit zou ik graag onder 1 cmd knop willen plaatsen, maar door het verschil in bereik lukt het niet om deze 3 bereiken samen te voegen als 1 code.
Het enigste verschil tussen deze 3 groepen is onderstaand stukje code :
Code: 
      For Each cChk In Me.grpFilter3.Controls
        i = i + 1
    If cChk.Value = True Then
        ReDim Preserve arrVals(i)
        arrVals(i) = cChk.Tag
    End If

    Next cChk
         ActiveSheet.Range("A15").CurrentRegion.AutoFilter _
         Field:=14, _
         Criteria1:=Array(arrVals), _
         Operator:=xlFilterValues

De verschillen zitten in de regel :
Code: 
 For Each cChk In Me.grpFilter3.Controls

en in :
Code: 
ActiveSheet.Range("A15").CurrentRegion.AutoFilter _
         Field:=14, _

Maar hoe deze tot 1 geheel te brouwen,.....ik heb geen idee.
Hopelijk kan iemand mij helpen
 
Ik had idd niet goed gelezen. Maar wil je een vb tje sturen? Werkt makkelijker...
 
Maar als opzetje:
Code: 
ActiveSheet.Range("A15").CurrentRegion.AutoFilter _
         Field:=14, _
kun je van maken:

Code: 
ActiveSheet.Range("A15").CurrentRegion.AutoFilter _
         Field:=inputbox("Welke kolom?"), _

en dan uiteraard het nummer (14) of desgewenst invoeren
 
Ik zou application.inputbox gebruiken waarbij je verplicht een getal moet invullen
 
Inderdaad zal alles wat duidelijker zijn met een vb.
 

Bijlagen

  • Test ranking.xlsm
    226,1 KB · Weergaven: 20
Hallo,
Ben nog een beetje aan het uitproberen geweest, en ben tot deze oplossing gekomen.
Ik heb een knop bij gemaakt, waarmee ik alle 3 de groepen aanroep.
Nu kan ik willekeurig ergens een checkbox in - of uitschakelen, druk vervolgens op de nieuwe knop en filtering wordt toegepast.
De 3 knoppen welke bij de 3 groepen hoorden, heb ik onzichtbaar gemaakt.....misschien nog eens handig in de toekomst.
Code: 
Private Sub cmdFilterToepassen_Click()
Application.ScreenUpdating = False

ActiveSheet.AutoFilterMode = False
Call cmdFilter_Functie_Click
Call cmdFilter_Ranking_Click
Call cmdFilter_Wettelijk_Click

Application.ScreenUpdating = True
End Sub
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan