Discussion :

[Regor]

Bonsoir

A l'aide d'un TextBox, je filtre l'affiche d'une ListBox. Par contre le code vba InStr m'oblige à respecter la casse. J'ai essayé avec StrComp mais sans succès.

J'ai aussi un problème d'affichage dans ma ListBox. Lors d'une recherche à l'aide d'un TextBox, si le résultat concerne plusieurs lignes c'est correct. Par contre, lorsqu'il reste qu'une ligne, l’affichage se fait à la verticale dans la Listbox.

Pour mieux comprendre mes problèmes, vous trouverez en pièce jointe le fichier Excel.

Je vous remercie de votre aide.

Cordialement

[NVCfrm]

Bonsoir

Pour la comparaison textuelle le quatrième argument de la fonction Instr permet cela: vbTextCompare ou 1.

Lors d'une recherche à l'aide d'un TextBox, si le résultat concerne plusieurs lignes c'est correct. Par contre, lorsqu'il reste qu'une ligne, l’affichage se fait à la verticale dans la Listbox.

J'aurais préféré avant de juger utile de télécharger le fichier, des explications détaillées avec au besoin les textes de codes en appui.
Si cela peut-être utile pour l'affichage vertical ou horizontal d'un tableau dans une listbox, voici 2 exemples d'affectation qui s'affichent différemment:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
 
Listbox1.List=Table
Listbox1.Column=Table

l'utilisation de Column transpose le tableau.
ah!

...lorsqu'il reste qu'une ligne, l’affichage se fait à la verticale dans la Listbox

.
Cela veut-il dire que toutes les lignes sont correctement chargés et la dernière ligne non?

[mercatog]

Une proposition sans dico

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
Private Sub TextBox7_Change()
Dim Ligne As Long, i As Long, j As Long
Dim Tb() As String, Rech As String
Dim k As Byte, m As Byte
 
With Feuil1
    Me.ListBox1.Clear
    Rech = Me.TextBox7
    Ligne = .Cells(.Rows.Count, "D").End(xlUp).Row
    If Rech <> "" Then
        For i = 8 To Ligne
            For m = 4 To 8
                If InStr(UCase(.Cells(i, m).Value), UCase(Rech)) <> 0 Then
                    j = j + 1
                    ReDim Preserve Tb(1 To 5, 1 To j)
                    For k = 0 To 4
                        Tb(k + 1, j) = .Cells(i, 4 + k).Value
                    Next k
                    Exit For
                End If
            Next m
        Next i
 
        If j > 0 Then
            With Me.ListBox1
                If j = 1 Then
                    .AddItem Tb(1, 1)
                    For k = 2 To 5
                        .List(.ListCount - 1, k - 1) = Tb(k, 1)
                    Next k
                Else
                    .List = Application.Transpose(Tb)
                End If
            End With
        End If
    Else
        Initlistbox1
    End If
End With
End Sub

[Regor]

Ci-dessous le code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
Private Sub TextBox8_Change()
Set dico = CreateObject("scripting.dictionary")
 
 
Dim Plage As Range, Cell As Range
Dim Recherche As String, Adresse As String
Dim Ligne As Integer, N As Integer
Dim C As Range, Sh As Worksheet
Set Sh = Sheets("Base")
 
 
Ligne = Feuil4.Range("C" & "65536").End(xlUp).Row
Set Plage = Feuil4.Range("C" & "6:" & "U" & Ligne)
 
Me.ListBox1.Clear
 For Each cel In Plage
 
 
       'If StrComp(cel.Value, TextBox1) <> 0 Then 'Sans contrôle sur les majuscules et les minuscules (ne fonctionne pas)
 
       If InStr(cel.Value, TextBox8) <> 0 Then 'Avec contrôle sur les majuscules et les minuscules
     x = Sheets("Base").Cells(cel.Row, 6) & ";" & Sheets("Base").Cells(cel.Row, 10) & ";" & Sheets("Base").Cells(cel.Row, 13) & ";" & Sheets("Base").Cells(cel.Row, 15) & ";" & Sheets("Base").Cells(cel.Row, 18) & ";" & Sheets("Base").Cells(cel.Row, 21)
     dico(x) = x
   End If
 Next
If dico.Count <> 0 Then
 a = dico.keys
 Dim liste()
 ReDim liste(0 To 5, UBound(a))
 For N = LBound(a) To UBound(a)
   liste(0, N) = Split(a(N), ";")(0)
   liste(1, N) = Split(a(N), ";")(1)
   liste(2, N) = Split(a(N), ";")(2)
   liste(3, N) = Split(a(N), ";")(3)
   liste(4, N) = Split(a(N), ";")(4)
   liste(5, N) = Split(a(N), ";")(5)
 Next N
 
 'Affichage des lignes dans listbox
 Me.ListBox1.List = Application.Transpose(liste)
 
End If
 If Me.TextBox8 = "" Then Call Initlistbox1
End Sub

[NVCfrm]

Bonsoir.

Ce qui est frappant c'est cet arsenal de boucles ça et là pour charger une liste.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Private Sub TextBox8_Change()
 
    Dim Tb, Cible, N As Integer, nb As Integer, L As Long, Present As Integer, x, Data As Range
 
    'Feuil1.Range("A1:H100").Formula = "=ROW()*COLUMN()&""ème Test"""
    nb = Feuil1.Columns(1).SpecialCells(11).Row
    ReDim Lx(1 To 1)
    Cible = TextBox1
    L = 8
    ReDim Tb(1 To 1)  'un tableau vide au départ
    With Feuil1
'6,10,13,15,18,21: 6 éléms
        Do
            Present = WorksheetFunction.CountIf(.Range(Cells(L, 3), Cells(L, 21)), "*" & Cible & "*")
            If Present Then
                N = N + 1
 
                ReDim Preserve Tb(1 To N)
                x = .Range(Cells(L, 1), Cells(L, 21))
                Tb(N) = Array(x(1, 6), x(1, 10), x(1, 13), x(1, 15), x(1, 18), x(1, 21))
 
            End If
            Present = 0
            L = L + 1
        Loop Until L = nb
    End With
    ListBox1.Clear
    If N Then
        x = WorksheetFunction.Transpose(Tb)
        ListBox1.List = x
        ListBox1.Column = ListBox1.List
    End If
End Sub

Je penses que ceci correspond à ce que tu veux.

Cordialement

Petite remarque sur la ligne de code contenant:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Present = WorksheetFunction.CountIf(.Range(Cells(L, 3), Cells(L, 21)), "*" & Cible & "*")

La fonction renverra tout ce qui contient le texte cherché. Si ce n'est pas ce que tu veux, il faut le changer par :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Present = WorksheetFunction.CountIf(.Range(Cells(L, 3), Cells(L, 21)), Cible)

Rectifier cible = Textbox1 avec le textbox concerné.

[Regor]

Merci pour ce code.

Ca fonctionne parfaitement.

Bonne après midi