Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Traduction code VBA - Recherche Multicritères (de

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 !

Blueangel

XLDnaute Junior
Bonjour à tous,

Il y a quelques jours, j'ai déposé un post sur EDL pour un coup de main pour faire une recherche multicritères.
Encore merci à MPO2 de m'avoir fourni un code "clé en main" qui fonctionne nickel.

Par contre, j'ai un gros (très gros même) souci de compréhension de ce code !
Est-ce que quelqu'un (MPO2 peut-être) pourrait m'ajouter quelques commentaires sur ce code (car j'aimerai l'utiliser pour mon 2e USF) ?

Voici mon fichier : Cijoint.fr - Service gratuit de dépôt de fichiers
--> Bouton "Rechercher" dans le USF G_Clients.

Merci d'avance,
@+
Blueangel
 
Re : Traduction code VBA - Recherche Multicritères (de

Bonjour,

J'ai ajouté quelques commentaires

Code:
Private Sub recherche_client_Click()
'''NE PAS CHANGER LE NOM DES TEXTBOX'''
Dim CTR As MSForms.Control
Dim Criteres()
Dim Tbl As Variant
Dim cpt&
Dim g&
Dim i&
Dim j&
Dim k&
Dim nbCol&
Dim T()
Dim T2()

'/// On balaie tous les contrôles du USF
For Each CTR In G_Clients.Controls
  '/// si ce sont des TextBo, on traite
  If TypeName(CTR) = "TextBox" Then
    '/// si la Textbox possède une valeur, on traite
    If CTR <> "" Then
      '/// tableau dynamique des critères
      cpt& = cpt& + 1
      ReDim Preserve Criteres(1 To 2, 1 To cpt&)
      '--- Numéro de la colonne ---
      '/// le n° est obtenu à partir du nom de la TextBox
      '/// on vire la longueur de "TextBox" et il reste le n°
      '/// c'est pour cette raison qu'il ne faut pas changer les noms des TextBox
      Criteres(1, cpt&) = CLng(Mid(CTR.Name, Len("TextBox") + 1))
      '--- Valeur de la TextBox ---
      Criteres(2, cpt&) = CTR
    End If
  End If
Next CTR
'/// si aucun critère n'a été trouvé, on sort
If cpt& = 0 Then
  MsgBox "Veuillez indiquer au moins un critère de recherche"
  IniListview (InitTableau)
  Exit Sub
End If
'/// on charge le tableau Tbl avec toutes les données de la feuille Clients
Tbl = InitTableau
'/// nombre de colonnes de la feuille et du tableau
nbCol& = UBound(Tbl, 2)

'/// on boucle sur toutes les lignes du tableau Tbl
For i& = 1 To UBound(Tbl, 1)
  '/// on boucle sur toutes les lignes du tableau Criteres
  For j& = 1 To cpt&
    '/// si correspondance Tbl vs Criteres on traite
    '/// Lcase sert à minisculiser les caractères
    If LCase(Tbl(i&, Criteres(1, j&))) = LCase(Criteres(2, j&)) Then
      k& = k& + 1
      '/// on redimensionne le  tableau T (seule la dernière dimension peut être redimensionnée)
      '/// 1ère dimension = colonnes   2ème dimension = lignes
      ReDim Preserve T(1 To nbCol&, 1 To k&)
      '/// sur la ligne qui va bien on affecte toutes les colonnes au tableau T
      For g& = 1 To nbCol&
        T(g&, k&) = Tbl(i&, g&)
      Next g&
    End If
  Next j&
Next i&
'/// si aucun critère trouvé, on sort
If k& = 0 Then
  MsgBox "Aucun critère n'a été trouvé"
  IniListview (InitTableau)
  Exit Sub
End If
'/// le tableau T a 2 dimensions colonnes et lignes
'/// on transpose pour avoir dans le tableau T2 lignes et colonnes
'--- Transposition du tableau ---
ReDim T2(1 To UBound(T, 2), 1 To UBound(T, 1))
For i& = 1 To UBound(T, 1)
  For j& = 1 To UBound(T, 2)
    T2(j&, i&) = T(i&, j&)
  Next j&
Next i&
'--------------------------------
'/// on envoie tout le tableau pour remplir la ListView
IniListview (T2)
End Sub

Est-ce plus parlant ?

Cordialement.

PMO
Patrick Morange
 
Re : Traduction code VBA - Recherche Multicritères (de

Merci beaucoup, c'est beaucoup plus clair. Quel boulot !! C'est de la gymnastique !! LOL
Je me permets, tout de même quelques questions supplémentaires :

Private Sub recherche_client_Click()
'''NE PAS CHANGER LE NOM DES TEXTBOX'''
Dim CTR As MSForms.Control
Dim Criteres()
Dim Tbl As Variant
Dim cpt&
Dim g&
Dim i&
Dim j&
Dim k&
Dim nbCol&
Dim T()
Dim T2()

'/// On balaie tous les contrôles du USF
For Each CTR In G_Clients.Controls
'/// si ce sont des TextBo, on traite
If TypeName(CTR) = "TextBox" Then
'/// si la Textbox possède une valeur, on traite
If CTR <> "" Then
'/// tableau dynamique des critères
cpt& = cpt& + 1 \\c'est quoi "cpt" ?
ReDim Preserve Criteres(1 To 2, 1 To cpt&) \\ ça stock tous les critères renseignés dans un tableau ?

'--- Numéro de la colonne ---
'/// le n° est obtenu à partir du nom de la TextBox
'/// on vire la longueur de "TextBox" et il reste le n°
'/// c'est pour cette raison qu'il ne faut pas changer les noms des TextBox
Criteres(1, cpt&) = CLng(Mid(CTR.Name, Len("TextBox") + 1))
'--- Valeur de la TextBox ---
Criteres(2, cpt&) = CTR
End If
End If
Next CTR
'/// si aucun critère n'a été trouvé, on sort
If cpt& = 0 Then
MsgBox "Veuillez indiquer au moins un critère de recherche"
IniListview (InitTableau)
Exit Sub
End If
'/// on charge le tableau Tbl avec toutes les données de la feuille Clients
Tbl = InitTableau
'/// nombre de colonnes de la feuille et du tableau
nbCol& = UBound(Tbl, 2) \\que signifie le 2e terme ? (F1 ne m'a pas aidé à comprendre)

'/// on boucle sur toutes les lignes du tableau Tbl
For i& = 1 To UBound(Tbl, 1)
'/// on boucle sur toutes les lignes du tableau Criteres
For j& = 1 To cpt&
'/// si correspondance Tbl vs Criteres on traite
'/// Lcase sert à minisculiser les caractères \\ à quoi ça sert ?
If LCase(Tbl(i&, Criteres(1, j&))) = LCase(Criteres(2, j&)) Then
k& = k& + 1
'/// on redimensionne le tableau T (seule la dernière dimension peut être redimensionnée)
'/// 1ère dimension = colonnes 2ème dimension = lignes
ReDim Preserve T(1 To nbCol&, 1 To k&)
'/// sur la ligne qui va bien on affecte toutes les colonnes au tableau T
For g& = 1 To nbCol&
T(g&, k&) = Tbl(i&, g&)
Next g&
End If
Next j&
Next i&
'/// si aucun critère trouvé, on sort
If k& = 0 Then
MsgBox "Aucun critère n'a été trouvé"
IniListview (InitTableau)
Exit Sub
End If
'/// le tableau T a 2 dimensions colonnes et lignes
'/// on transpose pour avoir dans le tableau T2 lignes et colonnes
'--- Transposition du tableau ---
ReDim T2(1 To UBound(T, 2), 1 To UBound(T, 1))
For i& = 1 To UBound(T, 1)
For j& = 1 To UBound(T, 2)
T2(j&, i&) = T(i&, j&)
Next j&
Next i&
'--------------------------------
'/// on envoie tout le tableau pour remplir la ListView
IniListview (T2)
End Sub

@+
Blueangel
 
Re : Traduction code VBA - Recherche Multicritères (de

Bonjour,

Code:
cpt& = cpt& + 1 \\c'est quoi "cpt" ?
C'est une variable de compteur et c'est pourquoi je l'appelle cpt
Je déclare les variables par suffixe. Dim cpt& est égale à Dim cpt As Long

Code:
nbCol& = UBound(Tbl, 2) \\que signifie le 2e terme ? (F1 ne m'a pas aidé à comprendre)
C'est un tableau bidimensionné. Si on fait UBound(Tbl, 1) on obtient le nombre de lignes et si on fait UBound(Tbl, 2) on obtient le nombre de colonnes

Code:
'/// Lcase sert à minisculiser les caractères \\ à quoi ça sert ?
Si on compare 2 variables pour voir si elles sont égales, TOTO est différent de Toto qui est différent de toto alors qu'au niveau de l'utilisateur c'est pareil. On emploie Lcase pour tout minusculiser (ou Ucase pour tout majusculiser) et on aura que des toto (ou des TOTO)

Cordialement.

PMO
Patrick Morange
 
Re : Traduction code VBA - Recherche Multicritères (de

C'est génial !! Merci beaucoup pour toutes ces précisions.
ça fonctionne nickel aussi pour mon 2e formulaire (y'a que la 1ère ligne à modifier finalement : le nom du formulaire !)
C'est sûr, je n'aurais jamais trouvé tout ça tout seul.

Merci.
@+
Blueangel
 
- 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
3
Affichages
380
Réponses
22
Affichages
2 K
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…