Sélectionner des colonnes non contiguës

ListBoxResultat.List = Range("A2:D" & Lign).Value

Function show_data_in_listbox()
ListBoxResultat.Column = 3              ' 3 colonnes dans la liste box qui affiche les lignes trouvées
ListBoxResultat.Column = "90,90,90"     ' largeur des colonnes
Sheets("Honda").Activate                ' onglet des données

Dim Lign As Long
Lign = Cells(Row.Count, "D").End(xlUp).Row
ListBoxResultat.List = Range("D6,H6:I" & Lign).Value

Merci d'avance

Hello,

Essaie ça :

Function show_data_in_listbox()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Honda")

    Dim Lign As Long
    Lign = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row

    Dim i As Long, j As Long
    Dim tempData() As Variant
    Dim rowCount As Long
    rowCount = Lign - 5 ' Nombre de lignes à lire à partir de la ligne 6

    If rowCount <= 0 Then Exit Function ' Pas de données à afficher

    ReDim tempData(1 To rowCount, 1 To 3) ' 3 colonnes : D, H, I

    For i = 1 To rowCount
        tempData(i, 1) = ws.Cells(i + 5, "D").Value ' Colonne D
        tempData(i, 2) = ws.Cells(i + 5, "H").Value ' Colonne H
        tempData(i, 3) = ws.Cells(i + 5, "I").Value ' Colonne I
    Next i

    With ListBoxResultat
        .ColumnCount = 3
        .ColumnWidths = "90;90;90"
        .List = tempData
    End With
End Function

@+

Bonjour Baroute78.

Whoaouuuu. Je vois que je netais pas prêt d'y arriver seul.

Je vais tester ça et je te fais un retour.

Ça marche plutôt bien.
Mais, car il y a un "mais", il y a une variable qui bloque.

    Dim ListCount1 As insteger

    ListCount1 = ListBoxResultat.ListCount - 1

j'ai un message d'erreur qui indique que la variable n'est pas définie.
Je mets le fichier, c'est dans le userform RechercherHonda.

Merci d'avance

Hello,

Regarde bien....

Bonne soirée

C'est gentil de vouloir m'aider mais je ne comprends pas ce qui cloche.

Edit : ho pu.... le s en trop...

MERCI BIEN

le diable se cache dans les détails.

l'œil de l'expert. Tu l'as vu direct.

Re-,

De l'expert, non, pas du tout

De l'habitué, peut-être...

il faut savoir que VBA corrige automatiquement la syntaxe du code (à l'inverse de Power Query, qui t'envoie direct en ....)

C'est pour cela, que, perso, j'utilise une certaine "habitude" :

- Déclarer les variables (rien de nouveau, Option Explicit peut le forcer)

- Tout écrire en minuscule (VBA corrige)

- Nommer mes variables avec un mélange "minuscule-majuscule" (Ex : Dim MaVar As String....)

Ainsi, dès que j'écris cette variable, si elle est reconnue, elle se met "Au Pas", sinon, elle reste en minuscule, et là, pas bon...

Bonne soirée

oui, j'essaie de faire ça autant que je peux, mais là, je n'ai pas été attentif.

Bon, je n'ai plus de bug bloquant, mais le filtrage ne fonctionne pas et, évidemment, je ne vois pas pourquoi.
sur le tuto, ça parait simple et ça fonctionne. https://www.youtube.com/watch?v=4XvmMx4kOys (il ne dure que 5 min )

quand j'utilise le code du tuto de expert-excel , (je renomme les "Private Sub RechercheDesignation000_Change()" en enlevant/réécrivant les "000"), ça fonctionne mais je n'ai qu'une colonne.
Quand je mets le code du tuto fb + la proposition de Baroute78, j'ai bien les 3 colonnes mais pas le filtrage.

Je pense que ce sont les textbox de recherche qu'il faut adapter, mais je ne sais pas le faire.

voici celle pour la colonne désignation

Private Sub RechercheDesignation_Change()
    Call show_data_in_listbox

    Dim Lign As Integer
    Dim ListCount1 As Integer

    ListCount1 = ListBoxResultat.ListCount - 1
    If RechercheDesignation <> "" Then

        For Lign = ListCount1 To 0 Step 1
            If InStr(1, UCase(ListBoxResultat.List(Lign, 2)), UCase(RechercheDesignation)) = False Then   ' 2 est le numéro de la colonne désignation (avec le code original du tuto fb)
            ListBoxResultat.RemoveItem (Lign)
            End If
        Next Lign
    End If
End Sub

@BAROUTE78

Je me pose la question : à quoi sert la variable "j" ?
elle ne semble pas être utilisée dans le code que tu as fait.

    Dim i As Long, j As Long

Hey,

Déclaration intempestive par réflexe sûrement

@+

ok,

Bon, je n'ai plus de bug bloquant, mais le filtrage ne fonctionne pas et, évidemment, je ne vois pas pourquoi. (voir mon message d'hier à 22h49)

J'ai encore du me foirer qq part. Je cherche plein de trucs, mais je n'ai pas encore trouvé.

La suite logique dans ce formulaire sera de pouvoir ouvrir le formulaire existant ModifierHonda

• soit par double-clic sur une ligne dans la ListBoxResultat (option préférée)
• soit en l'ayant sélectionnée dans la ListBoxResultat, la ligne s'affiche dans la TextBoxSelection et qu'on puisse déclencher l'ouverture du formulaire de modification par le bouton "Modifier" (que je dois créer).

NB : dans le tableau, si on double-clic sur une ligne, ça ouvre déjà ce formulaire ModifierHonda.

NB : J'avais déjà fait le bouton "Voir la ligne sélectionnée" (pour ouvrir le formulaire ModifierHonda)

Les colonnes s'initialisent bien dans la ListboxResultat.

Je pense à une chose, ne serait il pas plus pertinent d'appeler le tableau, qui s'appelle Tableau1, que d'appeler l'onglet Honda ?

re,

Je cherchais une chose hyper simple à mettre dans mon code ...

Module6, fonction personnalisée f_Honda(sRef As String, sDesign As String, sDim As String) avec donc les 3 variables avec lesquels vous voulez filtrer. Le résultat sera une matrice de 3 colonnes qui contient éventuellement un message d'erreur.

Puis dans "RechercherHonda", la "UserForm_Initialize()" est aussi utilisée pour chaque modification des 3 textboxes.

PS. Je suppose que ce serait facile d'ajouter une 4ème colonne avec le N° du listrow

Bonjour BsAlv

Alors là, je suis sur mon séant (mon postérieur si vous préférez), c'est pile ce que j'espérais en faisant ma lettre au père Noël (St Nicolas en Hollande si je ne me trompe pas).
Non seulement ça fonctionne impeccable mais en plus en cliquant sur une ligne, ça ouvre direct le formulaire ModifierHonda comme je voulais.

Un grand BRAVO et un GRAND MERCI à vous !
Je vais nettoyer le code (enlever tous les codes mis en commentaire pour les annihiler) afin de rendre ces pages "propres".
et je remettrai le fichier en ligne dans quelques minutes.

Voici le fichier "nettoyé" de certains codes inutiles à présent.

Serait-il possible de pouvoir modifier une ligne du tableau via le formulaire sans qu'il me duplique la ligne, comme le nom du bouton l'indique ?
J'ai repris d'ailleurs la fonction "dupliquer" en copier-coller de ce code et ajouter le bouton du même nom.
Merci d'avance

Pour le formulaire de Recherche, je me suis aperçu qu'il serait utile d'avoir la recherche sur la référence d'origine.
J'ai essayé plein de codage pour réutilisé la variable sRef provenant de la TextBox RechercherReference mais je n'y suis pas parvenu.
Je ne dois pas être très loin, mais la ListBox n'affiche que 3 colonnes systématiquement.
Elle m'affiche bien la colonne des références d'origine, mais plus les dimensions.
Quand j'essaie de changer ça, j'ai un bug.

et la recherche n'est pas efficace.

je mets ici le codage que j'ai tenté de modifier. il n'est pas dans le fichier "nettoyé".

Function f_Honda(sRefNew As String, sDesign As String, sDim As String)
     Dim Arr, NDX(1 To 5), i, s, arr1(1 To 4), aOut, sErreur As String
     sRefOri = sRefNew

     With Range("tableau1").ListObject       'votre tableau
          If .ListRows.Count = 0 Then        'est-il vide
               sErreur = "erreur tableau vide"
          Else
               NDX(1) = Application.IfError(.ListColumns("Honda_Origine").Index, 0)     'position de cette colonne
               NDX(2) = Application.IfError(.ListColumns("New_Ref_Honda").Index, 0)     'position de cette colonne
               NDX(3) = Application.IfError(.ListColumns("désignation").Index, 0)
               NDX(4) = Application.IfError(.ListColumns("dimensions").Index, 0)
               NDX(5) = 1                    'temporairement 1, ce sera plus tard pour le n° du listrow
               If WorksheetFunction.Product(NDX) = 0 Then     'vérifier si les 4 colonnes sont connues
                    s_Erreur = "erreur colonnes"     'au min une des colonnes est inconnue
               Else
                    Arr = .DataBodyRange.Value2     'le contenu du tableau
                    ReDim Preserve Arr(1 To UBound(Arr), 1 To UBound(Arr, 2) + 1)
                    NDX(5) = UBound(Arr, 2)  ' pour le n° du listrow

                    arr1(1) = sRef           'filtrer Honda_Origine avec cette valeur
                    arr1(2) = sRef           'filtrer New_Ref_Honda avec cette valeur
                    arr1(3) = sDesign        'idem pour désignation
                    arr1(4) = sDim           'idem pour dimensions
                    For i = 1 To UBound(Arr)     'boucler toutes les lignes du tableau
                         Arr(i, UBound(Arr, 2)) = i
                         b = True            'drapeau VRAI au début
               '          For j = 1 To 3      'boucler ces 3 colonnes
                         For j = 1 To 4      'boucler ces 4 colonnes
                              If arr1(j) <> "" Then     ' la valeur du filtre n'est pas vide
                                   b = (InStr(1, Arr(i, NDX(j)), arr1(j), 1) > 0)     'la valeur se trouve dans cette cellule (en ignorant majuscules/miniscules)
                                   If Not b Then Exit For     'si drapeau est déjà faux, inutile de continuer
                              End If
                         Next
                         If b Then s = s & vbLf & i     ' si drapeau encore vrai, alors ajouter N° listrow
                    Next

                    If s = "" Then           'aucune ligne du tableau correspond !!!
                         sErreur = "aucune référence trouvée"
                    Else
                         sp = Split(Mid(s, 2), vbLf)     'splitter les N° des listrows
                         If UBound(sp) = 0 Then     'cas spécial, seulement une ligne qui correspond
                              X = Application.Index(Arr, sp, NDX)     'les 3 valeurs voulues (mais en mauvais format)
                              ReDim aOut(1 To 1, 1 To UBound(X))     'redimensioner matrice avec bon format
                              For i = 1 To UBound(X): aOut(1, i) = X(i): Next     'coller dans cette matrice
                         Else
                              aOut = Application.Index(Arr, Application.Transpose(sp), NDX)     'coller résultat directement dans la matrice
                         End If
                    End If
               End If
          End If
     End With

     If Len(sErreur) Then                    'on a eu une erreur pendant cette fonction
  '        ReDim aOut(1 To 1, 1 To 4)         'redimensioner matrice avec bon format
          ReDim aOut(1 To 1, 1 To 5)         'redimensioner matrice avec bon format
          aOut(1, 1) = sErreur               'ajouter cause de l'erreur
     End If

     f_Honda = aOut

End Function

Merci d'avance.

pour écraser une ligne existante, c'est cette ajout dans Sub CB_Sauvegarder_Click() qui le fait (et d'où l'importance que "TextBoxNumLigne" est toujours mis à jour)

 iLigne = Val(TextBoxNumLigne.Text)     'quelle est la ligne à écraser (valeur de textboxnumligne)
          If iLigne < 1 Or iLigne > .ListRows.Count Then     'ligne n'est pas dans le tableau
               MsgBox "erreur avec le nombre dans TextBoxNumLigne : " & TextTextBoxNumLigne.Text, vbCritical
               Exit Sub
          End If
          Set c = .ListRows(iLigne).Range    '**************** maintenant c'est cette ligne existante à écraser dans le tableau "tableau1" ***************************************
        

Au moment où vous demandez la "rechercherHonda" la macro "Sub Rechercher02_Click()" dit le largeur et le nombre des colonnes (normallement cela n'est pas nécessaire chaque fois). Je l'ai mis là parce que la function "show_data_in_listbox" est inutile pour le moment. Maintenant les 4 colonnes sont visibles.

Vous ne voulez plus regarder dans la colonne "New_Ref_Honda" mais dans la colonne "Honda_Origine", bon, dans le module6, fonction "Function f_Honda(sRef As String, sDesign As String, sDim As String)",on a cette ligne. Vous modifiez "New_Ref_Honda" en "Honda_Origine", c'est tout

             NDX(1) = Application.IfError(.ListColumns("New_Ref_Honda").Index, 0)     'position de cette colonne

et la recherche n'est pas efficace.

Cela veut dire quoi exactement ? On recherche bien l'existance d'une chaine de charactères dans ces 3 colonnes. Il manque quelqu'unes ou il y a des lignes de trop. Si votre version d'Excel la permit, normallement okay pour 2021, à partir de la ligne 1333, on a la version en formules. Le filtrage se fait avec les cellules jaunes.

Je n'ai pas encore ouvert votre dernier ficher.

Je vois que dans ma demande que je n'ai pas été assez précis.

Je désirerai que depuis la textbox RechercheReference les valeurs saisies recherche dans les deux colonnes Ref_Origine ET New_Ref_Honda.

Quand je disais que la recherche n'était efficace, c'était avec mes tentatives de (mauvais) codage VBA. Donc mauvais code = mauvais fonctionnement. C'est logique.

Merci beaucoup.

je vois ça cet am.

re,

j'ai ajouté un nouveau textbox àl'userform "RechercherHonda", mais je suppose que vous modifierez son layout à votre goût. (Quand je vois votre poste de hier 13:19, c'était presque correcte !)

Une fois que vous comprenez le fonctionnement du filtrage, vous pouvez aussi supprimer ces lignes à partir de 1333.

Bonjour BsAlv,

on avance bien !

Mon souhait était de pouvoir saisir que dans la TextBox rechercherReference et que ça cherche dans les 2 colonnes, HondaOrigine et NewRefHonda.
Je ne sais pas si c'est possible.

J'ai corrigé la ligne suivante car le double clic ne fonctionnait plus pour ouvrir (par double-clic) le formulaire ModifierHonda
Listrow est dans la 5 ème colonne à présent.

Private Sub ListBoxResultat_Click()
     Dim i
     With ListBoxResultat
          If .ListIndex <> -1 Then           ' on a choisi
           '    i = .List(.ListIndex, 3)      ' N° du listrow était dans la 4ème colonne de la matrice (3ème si on commence avec 0)
               i = .List(.ListIndex, 4)      ' N° du listrow était dans la 5ème colonne de la matrice (4ème si on commence avec 0) 24/06/2025

on a un plantage si aucune valeur n'est trouvée quand on est en train de saisir une valeur dans une des 3 TextBox (new ref, désignation, dimensions )
Par exemple : 80123m dans les références ou vis 10x

J'ai corrigé comme suit, mais ce n'est pas suffisant.

J'espère que cette ligne est correcte. Je modifie pas à pas sans vraiment être sûr de ce que je fais.

Application.Goto Range("tableau1").Cells(i, 1)     'se déplacer vers cette ligne en colonne "HondaOrigine"  24/06/2024

Private Sub ListBoxResultat_Click()
     Dim i
     With ListBoxResultat
          If .ListIndex <> -1 Then           ' on a choisi
           '    i = .List(.ListIndex, 3)      ' N° du listrow était dans la 4ème colonne de la matrice (3ème si on commence avec 0)
               i = .List(.ListIndex, 4)      ' N° du listrow était dans la 5ème colonne de la matrice (3ème si on commence avec 0)  24/06/2025
               If i > 0 Then                 ' N° listrow est connu (donc pas d'erreur)
                    Ligne_ModificationHonda = i     'assigner cette valeur
               '     Application.Goto Range("tableau1").Cells(i, 3)     'se déplacer vers cette ligne en colonne "New_Ref_Honda"
                    Application.Goto Range("tableau1").Cells(i, 1)     'se déplacer vers cette ligne en colonne "HondaOrigine"  24/06/2024
                    Unload Me                ' cet userform a fait son boulot, donc exit
                    M_ModifHonda Ligne_ModificationHonda     'lancer nouvel userform
               End If
          End If
     End With
End Sub