Filtrer par macro

Le 05/09/2014 à 12:32

Bonjour,

j'ai fait une macro qui filtre une feuille en partant de la colonne B Ligne 1 et c'est ok

If Me.CmbBxName.ListIndex = -1 Then Exit Sub B = colonne 2

Maintenant j'aimerai une macro qui filtre de la colonne F (F=6) Ligne 1

Mais je ne comprend pas la logique du code.

Dim OffAction As Boolean

Private Sub CmdBtnFermer_Click()
Unload Me
End Sub

Private Sub UserForm_Initialize()
Application.ScreenUpdating = False
 Me.Height = Application.Height
 Me.Width = Application.Width
 End Sub

'************************ COMMANDE BOUTON FILTRER PAR NAME **************************
'
Private Sub CmbBxName_Change()
    If Me.CmbBxName.ListIndex = -1 Then Exit Sub
    If OffAction = True Then Exit Sub
    TextBox2.Text = Sheets("Annuaire").Cells(CmbBxName.ListIndex + 1, 1).Value
    TextBox3.Text = Sheets("Annuaire").Cells(CmbBxName.ListIndex + 1, 2).Value
    TextBox4.Text = Sheets("Annuaire").Cells(CmbBxName.ListIndex + 1, 3).Value
    TextBox5.Text = Sheets("Annuaire").Cells(CmbBxName.ListIndex + 1, 4).Value
    TextBox6.Text = Sheets("Annuaire").Cells(CmbBxName.ListIndex + 1, 5).Value
    TextBox7.Text = Sheets("Annuaire").Cells(CmbBxName.ListIndex + 1, 6).Value
    TextBox8.Text = Sheets("Annuaire").Cells(CmbBxName.ListIndex + 1, 7).Value
    TextBox9.Text = Sheets("Annuaire").Cells(CmbBxName.ListIndex + 1, 8).Value
    TextBox10.Text = Sheets("Annuaire").Cells(CmbBxName.ListIndex + 1, 9).Value
    TextBox11.Text = Sheets("Annuaire").Cells(CmbBxName.ListIndex + 1, 10).Value
    TextBox13.Text = Sheets("Annuaire").Cells(CmbBxName.ListIndex + 1, 11).Value
    TextBox14.Text = Sheets("Annuaire").Cells(CmbBxName.ListIndex + 1, 12).Value
    TextBox15.Text = Sheets("Annuaire").Cells(CmbBxName.ListIndex + 1, 13).Value
    TextBox16.Text = Sheets("Annuaire").Cells(CmbBxName.ListIndex + 1, 14).Value
    TextBox17.Text = Sheets("Annuaire").Cells(CmbBxName.ListIndex + 1, 15).Value
    TextBox18.Text = Sheets("Annuaire").Cells(CmbBxName.ListIndex + 1, 16).Value
    TextBox19.Text = Sheets("Annuaire").Cells(CmbBxName.ListIndex + 1, 17).Value
    TextBox20.Text = Sheets("Annuaire").Cells(CmbBxName.ListIndex + 1, 18).Value
    TextBox21.Text = Sheets("Annuaire").Cells(CmbBxName.ListIndex + 1, 19).Value
    TextBox22.Text = Sheets("Annuaire").Cells(CmbBxName.ListIndex + 1, 20).Value
    TextBox23.Text = Sheets("Annuaire").Cells(CmbBxName.ListIndex + 1, 21).Value
    TextBox12.Text = Sheets("Annuaire").Cells(CmbBxName.ListIndex + 1, 22).Value

End Sub

'************************ COMMANDE BOUTON FILTRER PAR TEL **************************
'
Private Sub CmbBxTel_Change()
    If Me.CmbBxTel.ListIndex = -1 Then Exit Sub
    If OffAction = True Then Exit Sub
    TextBox2.Text = Sheets("Annuaire").Cells(CmbBxName.ListIndex + 6, 1).Value
    TextBox3.Text = Sheets("Annuaire").Cells(CmbBxName.ListIndex + 6 2).Value
    TextBox4.Text = Sheets("Annuaire").Cells(CmbBxName.ListIndex + 6, 3).Value
    TextBox5.Text = Sheets("Annuaire").Cells(CmbBxName.ListIndex + 6, 4).Value
    TextBox6.Text = Sheets("Annuaire").Cells(CmbBxName.ListIndex + 6, 5).Value
    TextBox7.Text = Sheets("Annuaire").Cells(CmbBxName.ListIndex + 6, 6).Value
    TextBox8.Text = Sheets("Annuaire").Cells(CmbBxName.ListIndex + 6, 7).Value
    TextBox9.Text = Sheets("Annuaire").Cells(CmbBxName.ListIndex + 6, 8).Value
    TextBox10.Text = Sheets("Annuaire").Cells(CmbBxName.ListIndex +6, 9).Value
    TextBox11.Text = Sheets("Annuaire").Cells(CmbBxName.ListIndex + 6, 10).Value
    TextBox13.Text = Sheets("Annuaire").Cells(CmbBxName.ListIndex + 6, 11).Value
    TextBox14.Text = Sheets("Annuaire").Cells(CmbBxName.ListIndex +6, 12).Value
    TextBox15.Text = Sheets("Annuaire").Cells(CmbBxName.ListIndex + 6, 13).Value
    TextBox16.Text = Sheets("Annuaire").Cells(CmbBxName.ListIndex +6, 14).Value
    TextBox17.Text = Sheets("Annuaire").Cells(CmbBxName.ListIndex + 6, 15).Value
    TextBox18.Text = Sheets("Annuaire").Cells(CmbBxName.ListIndex + 6, 16).Value
    TextBox19.Text = Sheets("Annuaire").Cells(CmbBxName.ListIndex +6, 17).Value
    TextBox20.Text = Sheets("Annuaire").Cells(CmbBxName.ListIndex + 6, 18).Value
    TextBox21.Text = Sheets("Annuaire").Cells(CmbBxName.ListIndex + 6, 19).Value
    TextBox22.Text = Sheets("Annuaire").Cells(CmbBxName.ListIndex + 6, 20).Value
    TextBox23.Text = Sheets("Annuaire").Cells(CmbBxName.ListIndex + 6, 21).Value
    TextBox12.Text = Sheets("Annuaire").Cells(CmbBxName.ListIndex +6, 22).Value

End Sub

Je ne peut vous joindre un fichier car trop de données privées

Merci pour votre aide.

Le 05/09/2014 à 14:48

Bonjour,

je ne comprend pas la logique du code

C'est quoi que tu ne comprends pas car si c'est toi qui a fais le code comment peux-tu ne pas en comprendre la logique ?

De toutes façons, ce n'est pas un filtrage qui est réalisé mais juste une récup de valeurs sur une ligne (colonnes A à V) définie par l'index de la combobox !

Entre parenthèses, si tu n'avait pas cette ligne là (suite à une modif de l'userform je pense) :

TextBox12.Text = Sheets("Annuaire").Cells(CmbBxName.ListIndex + 1, 22).Value

tu aurais pus utiliser une boucle afin de raccourcir...

For I = 2 To 23

    Me.Controls(" TextBox" & I).Text = Sheets("Annuaire").Cells(CmbBxName.ListIndex + 1, I - 1).Value

Next I

Avec ceci :

.Cells(CmbBxName.ListIndex + 6, 1).Value

tu récupère les valeurs situées 5 lignes (ListIndex de la combo commençant à 0) plus bas que la position de l'item sélectionné dans la combo donc, si tu veux faire un filtrage, il faut procéder tout autrement.

Il te faut effectuer un filtrage avec "AutoFilter" sur une plage définie du genre (avec "UsedRange" ici, les valeurs sont sensées commencer en colonne A) :

Set Plage = Worksheets("Feuil1").UsedRange

With Plage

    'colonne B
    .AutoFilter 2, Me.CmbBxName.Text & "*"

End With

et ensuite, récupérer les lignes filtrées comme par exemple le numéro des lignes dans un tableau car il y a de fortes chances pour que plusieurs enregistrements soient retournés :

Dim Tbl() As Long 'en tête du module du formulaire...

Sub Filtre()

    Dim Plage As Range
    Dim Cel As Range

    Set Plage = Worksheets("Feuil1").UsedRange

    With Plage

        'colonne B
        .AutoFilter 2, Me.CmbBxName.Text & "*"

    End With

    For Each Cel In Plage.Rows

        If Cel.EntireRow.Hidden = False Then

            I = I + 1
            ReDim Preserve Tbl(1 To I)
            Tbl(I) = Cel.Row

        End If

    Next Cel

End Sub

Ceci fait, à l'aide par exemple d'un contrôle Toupie dont tu défini les bornes en fin de filtrage comme ceci :

Sub Filtre()

    Dim Plage As Range
    Dim Cel As Range

    Set Plage = Worksheets("Feuil1").UsedRange

    With Plage

        'colonne B
        .AutoFilter 2, Me.CmbBxName.Text & "*"

    End With

    For Each Cel In Plage.Rows

        If Cel.EntireRow.Hidden = False Then

            I = I + 1
            ReDim Preserve Tbl(1 To I)
            Tbl(I) = Cel.Row

        End If

    Next Cel

    Me.SpinButton1.Max = 1
    Me.SpinButton1.Max = UBound(Tbl)

End Sub

tu fais défiler les valeurs des lignes dans tes contrôles :

Private Sub SpinButton1_Change()

    TextBox2.Text = Sheets("Annuaire").Cells(Tbl(SpinButton1.Value), 1).Value
    TextBox3.Text = Sheets("Annuaire").Cells(Tbl(SpinButton1.Value), 2).Value
    TextBox4.Text = Sheets("Annuaire").Cells(Tbl(SpinButton1.Value), 3).Value
    TextBox5.Text = Sheets("Annuaire").Cells(Tbl(SpinButton1.Value), 4).Value
    TextBox6.Text = Sheets("Annuaire").Cells(Tbl(SpinButton1.Value), 5).Value
    TextBox7.Text = Sheets("Annuaire").Cells(Tbl(SpinButton1.Value), 6).Value
    'etc...

End Sub

Ceci n'est qu'une ébauche mais ça te donne une direction. Bon courage.

Hervé.

Le 05/09/2014 à 15:44

Bonjour Hervé,

Entre parenthèses, si tu n'avait pas cette ligne là (suite à une modif de l'userform je pense) :

TextBox12.Text = Sheets("Annuaire").Cells(CmbBxName.ListIndex + 1, 22).Value

Cette ligne est déplacée en bas du code, comme tu le dis suite à un changement sur le UserForm.

Merci pour ton code.

Voilà de quoi me faire passer un week-end au chaud pour tout comprendre.

Merci très sincèrement

Rechercher des sujets similaires à "filtrer macro"