Discussion :

[familledacp]

Bonsoir à tous et à toutes

Je sèche sur le sujet suivant.

Peut être que j'aurai pu attendre quelques semaines car je viens de m'inscrire pour 2 journées de formation VBA

Je souhaite filtrer les données apparaissant dans la listbox

Cette listbox présente 2 colonnes

Je souhaite que les données soient filtrées selon le critère suivant : seules apparaissent les lignes où le dernier caractère de la 2e colonne est un "D"

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
Private Sub UserForm_Initialize()
 
Dim fichier As String
Dim LastLig As Long
 
fichier = "e:\MaterBAse.xls"
 
Set Wbk = Workbooks.Open(fichier)
 
With Sheets("BASEliste").Range("AL3")
             Me.ListBox1.RowSource = Range(.Cells, .End(xlDown)(1, 2)).Address(External:=True)
End With
 
 
End Sub

Merci pour votre aide

Daniel S

[jojo86]

Peut etre en faisant une boucle sur les ligne de ton fichier?
Je n'ai pas excel sous la main, donc je ne peux pas tester mon code... Mais je pense que ca peux t'aider.

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
Private Sub UserForm_Initialize()
 
Dim fichier As String
Dim LastLig As Long
Dim i as Integer
 
fichier = "e:\MaterBAse.xls"
 
Set Wbk = Workbooks.Open(fichier)
LastLig=Sheets("BASEliste").Range("AL3").End(xlDown)
 
For i = 3 to LastLig do
    If Right(Sheets("BASEliste").Range("AL" & CStr(i)), 1)="D" then
        Me.listBox1.AddItem Sheets("BASEliste").Range("AL" & CStr(i))
    End If
Next i
End Sub

Le top serait une requete classeur fermé surtout si tu ouvre juste le fichier masterBase uniquement pour charger ta liste.

Bref,
Bonne soirée!

[familledacp]

Bonjour

Merci pour cette réponse ultra rapide

J'ai désormais une erreur "incompatibilité de type" au chargement de l'userform

Je cherche, mais si quelqu'un a une réponse ...

Bon week end !

Daniel

[Paritec]

Bonjour à Tous, le forum
à mon avis comme cela ce serait mieux
a+
papou

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub UserForm_Initialize()
 
Dim fichier$,LastLig&,i & ,wbk as workbook
fichier = "e:\MaterBAse.xls" 
Set Wbk = Workbooks.Open(fichier)
LastLig=Sheets("BASEliste").Range("AL" & rows.count).End(xlup).row
 
For i = 3 to LastLig 
    If Right(Sheets("BASEliste").Range("AL" & i),1)="D" then
        Me.listBox1.AddItem Sheets("BASEliste").Range("AL" & i)
    End If
Next i
wbk.close 
End Sub

[fring]

Bonjour,

Si j'ai bien compris, cela devrait ressembler à ceci :

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
Private Sub UserForm_Initialize()
Dim Wbk As Workbook, Fichier As String, DerLig As Long, x As Long
Dim Col1 As String, Col2 As String
 
Application.ScreenUpdating = False '<-- figer l'écran pour ne pas voir l'ouverture du classeur source
 
Fichier = "e:\MaterBAse.xls"
Col1 = "A" '<-- colonne 1 du classeur source à adapter
Col2 = "B" 'colonne 2 du classeur source à adapter
Set Wbk = Workbooks.Open(Fichier) '<-- ouverture du classeur source
 
With Wbk.Sheets("BASEliste") '<-- on fait référence à la feuille "Baseliste" du classeur source
    DerLig = .Cells(Rows.Count, Col1).End(xlUp).Row '<-- recherche de la dernière ligne de la colonne 1
    For x = 1 To DerLig '<-- de la ligne 1 à la dernière ligne (ligne de départ à adapter)
        If UCase(Right(.Cells(x, Col2), 1)) = "D" Then '<--si le dernier caractère de la colonne 2 correspond à "d" ou "D"
            Me.ListBox1.AddItem .Cells(x, Col1) '<-- chargement de la première colonne de la ListBox avec la valeur de la colonne 1
            Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = .Cells(x, Col2) '<-- chargement de la seconde colonne de la ListBox avec la valeur de la colonne 2
        End If
    Next
End With
 
Wbk.Close False '<-- fermeture du classeur source, sauvegarde = non
Set Wbk = Nothing '<-- libération de la mémoire
Application.ScreenUpdating = True '<-- réactivation de l'écran
End Sub

[familledacp]

Bonjour à tous

Merci à Fring et Paritec pour leurs réponses

J'ai utilisé le code de Fring qui fonctionne parfaitement

bonne journée !

Daniel S