Rechercher via listbox

Le 13/12/2019 à 17:25

Salut chers tous

Je voudrais a l'aide de listbox afficher les enregistrements concernant un code donné

Le code de recherche a été fait mais un soucis se pressente

Pourriez vous jeter un coup d’œil et m'aider ?

Merci

7rech-copie.xlsm (149.82 Ko)
Le 13/12/2019 à 17:35

Bonjour

il trouve l'onglet Sheets("Grille_de_Dispensation")

mètre plutôt le codename

ex:

dl = Feuil1.Range("A" & Rows.Count).End(xlUp).Row
With Feuil1.[A1].CurrentRegion.Resize(dl, 11)

A+

Maurice

Le 13/12/2019 à 17:59
archer a écrit :

Bonjour

il trouve l'onglet Sheets("Grille_de_Dispensation")

mètre plutôt le codename

ex:

dl = Feuil1.Range("A" & Rows.Count).End(xlUp).Row
With Feuil1.[A1].CurrentRegion.Resize(dl, 11)

A+

Maurice

Oui jai fais cette correction mais toujours un soucis lors de la recherche quand je saisi dans le text box de recherche

Le 13/12/2019 à 19:35

Salut KTM le fil...

Dis moi quand tu dis un soucis se présente tu parles de l'erreur sur ListBox2.Clear ? Si c'est ça c'est normal dans UserForm_Initialise tu as mis :

Private Sub UserForm_Initialize()
Dim dl As Long
dl = Sheets("Grille_de_Dispensation").Range("A" & Rows.Count).End(xlUp).Row
With Sheets("Grille_de_Dispensation").[A1].CurrentRegion.Resize(dl, 11)
    ListBox2.ColumnCount = .Columns.Count
    If .Rows.Count > 1 Then ListBox2.RowSource = .Rows(2).Resize(.Rows.Count - 1).Address
End With
End Sub

Tu attibue donc une valeur à RowSource et tu ne peux pas faire un .Clear. tu dois changer ton code comme ceci en effaçant le .RowSource

Private Sub TextBox6_Change()
Dim S As String, i As Long, Lmax As Long, Nbr As Long, k As Long, NbreCol As Integer
Dim L, V, LigneOK, m As Long
NbreCol = 11
    If TextBox6 = "" Then
Dim xRg As Range
    Set xRg = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp).Offset(, 10))
    ListBox2.ColumnHeads = False
    ListBox2.List = xRg.Value
    Else

       ListBox2.RowSource = ""
        Lmax = Range("A" & Rows.Count).End(xlUp).Row
        V = Range(Range("A2"), Cells(Lmax, NbreCol)).Value
        ReDim LigneOK(1 To Lmax - 1)

        S = "*" & LCase(TextBox6) & "*"
        For i = 1 To Lmax - 1
            For m = 1 To NbreCol
                LigneOK(i) = False
                If LCase(V(i, m)) Like S Then
                    LigneOK(i) = True
                    Nbr = Nbr + 1
                    Exit For
                End If
            Next m
        Next i
        If Nbr = 0 Then Exit Sub
            ReDim L(0 To Nbr - 1, 0 To NbreCol - 1)
            Nbr = -1
            For i = 1 To Lmax - 1
                If LigneOK(i) Then
                    Nbr = Nbr + 1
                    For k = 0 To NbreCol - 1
                        L(Nbr, k) = V(i, k + 1)
                    Next k
                End If
            Next i
            ListBox2.List = L
    End If
End Sub

J'espère ne pas me tromper d'erreur.

Le 13/12/2019 à 19:45
Jean-Paul a écrit :

Salut KTM le fil...

Dis moi quand tu dis un soucis se présente tu parles de l'erreur sur ListBox2.Clear ? Si c'est ça c'est normal dans UserForm_Initialise tu as mis :

Private Sub UserForm_Initialize()
Dim dl As Long
dl = Sheets("Grille_de_Dispensation").Range("A" & Rows.Count).End(xlUp).Row
With Sheets("Grille_de_Dispensation").[A1].CurrentRegion.Resize(dl, 11)
    ListBox2.ColumnCount = .Columns.Count
    If .Rows.Count > 1 Then ListBox2.RowSource = .Rows(2).Resize(.Rows.Count - 1).Address
End With
End Sub

Tu attibue donc une valeur à RowSource et tu ne peux pas faire un .Clear. tu dois changer ton code comme ceci en effaçant le .RowSource

Private Sub TextBox6_Change()
Dim S As String, i As Long, Lmax As Long, Nbr As Long, k As Long, NbreCol As Integer
Dim L, V, LigneOK, m As Long
NbreCol = 11
    If TextBox6 = "" Then
Dim xRg As Range
    Set xRg = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp).Offset(, 10))
    ListBox2.ColumnHeads = False
    ListBox2.List = xRg.Value
    Else

       ListBox2.RowSource = ""
        Lmax = Range("A" & Rows.Count).End(xlUp).Row
        V = Range(Range("A2"), Cells(Lmax, NbreCol)).Value
        ReDim LigneOK(1 To Lmax - 1)

        S = "*" & LCase(TextBox6) & "*"
        For i = 1 To Lmax - 1
            For m = 1 To NbreCol
                LigneOK(i) = False
                If LCase(V(i, m)) Like S Then
                    LigneOK(i) = True
                    Nbr = Nbr + 1
                    Exit For
                End If
            Next m
        Next i
        If Nbr = 0 Then Exit Sub
            ReDim L(0 To Nbr - 1, 0 To NbreCol - 1)
            Nbr = -1
            For i = 1 To Lmax - 1
                If LigneOK(i) Then
                    Nbr = Nbr + 1
                    For k = 0 To NbreCol - 1
                        L(Nbr, k) = V(i, k + 1)
                    Next k
                End If
            Next i
            ListBox2.List = L
    End If
End Sub

J'espère ne pas me tromper d'erreur.

MERCI

JEAN PAUL c'est très juste

Rechercher des sujets similaires à "rechercher via listbox"