XL 2016 changement en fonction des valeurs contenues dans une listbox

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

patrick60880

XLDnaute Nouveau
Bonjour à tout le forum.
J'ai une petite question technique qui me pose problème:
J'ai une listbox avec 12 colonnes. Cette listbox est alimentée par un combobox. Ensuite je trie cette listbox par 2 option button en fonction des données contenues dans la colonne 12.
La colonne 12 ne comporte que les chiffres 0 et 1. Mon option button 1 affiche les chiffres 1 et mon option button 2 affiche le chiffre 0.
Ma question: Est-il possible de faire apparaître l'option button 2 que s'il y a au moins une valeur 0 dans la colonne 12 de ma listbox?
Voici mes codes pour les 2 option button:

Private Sub OPT1_Click()
Dim Tbl()
articles = Me.ComboBox1
n = 0
For i = 1 To UBound(BD)
If BD(i, 2) Like articles And BD(i, 12) <> "0" Then
n = n + 1: ReDim Preserve Tbl(1 To Ncol, 1 To n)
For K = 1 To Ncol: Tbl(K, n) = BD(i, K): Next K

If i = UBound(BD) Then Exit For
If BD(i, 1) <> BD(i + 1, 1) Then
n = n + 1
ReDim Preserve Tbl(1 To UBound(BD, 2), 1 To n)
End If

End If
Next i
If n > 0 Then
Me.ListBox1.Column = Tbl
Me.Label3.Caption = Me.ListBox1.ListCount & " Ligne(s)"
Else
Me.ListBox1.Clear
Me.Label3.Caption = ""
End If

End Sub

Private Sub OPT2_Click()
Dim Tbl()
articles = Me.ComboBox1
n = 0
For i = 1 To UBound(BD)
If BD(i, 2) Like articles And BD(i, 12) <> "1" Then
n = n + 1: ReDim Preserve Tbl(1 To Ncol, 1 To n)
For K = 1 To Ncol: Tbl(K, n) = BD(i, K): Next K

If i = UBound(BD) Then Exit For
If BD(i, 1) <> BD(i + 1, 1) Then
n = n + 1
ReDim Preserve Tbl(1 To UBound(BD, 2), 1 To n)
End If

End If
Next i
If n > 0 Then
Me.ListBox1.Column = Tbl
Me.Label3.Caption = Me.ListBox1.ListCount & " Ligne(s)"
Else
Me.ListBox1.Clear
Me.Label3.Caption = ""
End If

End Sub
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
5
Affichages
235
Réponses
8
Affichages
233
  • Question Question
Microsoft 365 Erreur UBound
Réponses
4
Affichages
144
Réponses
3
Affichages
664
Réponses
10
Affichages
281
Réponses
4
Affichages
177
  • Question Question
Microsoft 365 worksheet_change
Réponses
29
Affichages
479
Réponses
8
Affichages
466
Retour