Sélectionner des colonnes non contiguës
NB : J'ai cette version d'Excel : ExcelPro + 2021 Fr comme indiqué dans mon profil. Installation faite sur mon pc, pas en ligne. (Je ne sais même pas si ça existe...)
J'avais déjà remarqué ça sur la version du fichier précédente.
mais on voit pourtant les images, même si dans le TBL_Images le listRow indique "0" .
Youpiiiii, j'ai trouvé comment contourner le blocage.
Dans le RechercherHonda, J'ai repris la variable "s" du module6 car le Ubound(X) affichait tout de même "1" quand il n'avait aucun résultat.
Je ne sais pas si c'est propre ou pas.
En tout cas, ça ne plante pas. Enfin... tant qu'on ne clique pas sur le message d'erreur qui est présent dans la colonne Désignation.
Private Sub UserForm_Initialize()
X = f_Honda(TB_HondaOriginal.Text, RechercherReference.Text, RechercheDesignation.Text, RechercherDimensions.Text) 'filtrer le tableau avec ces 4 valeurs
ListBoxResultat.List = X
' If ListBoxResultat.List(0, 4) = "" Then ' aucun N° du listrow dans la première ligne de la matrice
If UBound(X) = 0 Then ' aucun N° du listrow dans la première ligne de la matrice 24/06/2025
NombreTouver.Text = "aucune" ' la matrice n'a rien trouvé
Else
NombreTouver.Text = UBound(X) ' nombre de lignes trouvées
End If
End SubDans le module 6, j'ai modifié ceci :
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
' aOut(1, 2) = sErreur 'ajouter cause de l'erreur dans la colonne de designation
aOut(1, 3) = sErreur 'ajouter cause de l'erreur dans la colonne de designation 24/06/2025Dans le formulaire ModifierHonda, serait il possible d'afficher le numéro de la ligne de la feuille et non celle du tableau ?
Dans le RechercherHonda, J'ai repris la variable "s" du module6 ça ne fonctionnait pas. J'ai remis
If UBound(X) = 0 Then re,
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.
Je suppose que cela veut dire oubien dans "HondaOriginal" oubien dans "NewRefHonda", 1 des 2 ...
okay, pour ce double clicque, c'est normal, on avait inséré une colonne
ce bug "80123m", au bout de la fonction "f_Honda" (module6), on a ceci, ce redim après une erreur créait une matrice de 4 colonnes au lieu de 5 avec ce ReDim aOut(1 To 1, 1 To 4) et alors i .List(.ListIndex, 4) était faux, parce qu'il n'existait pas une 5ème listcolumn (avec index 4 pour simplifier les choses)
If Len(sErreur) Then 'on a eu une erreur pendant cette fonction
ReDim aOut(1 To 1, 1 To 5) 'redimensionner matrice avec bon format !!! 5 au lieu de 4 !!!!
' aOut(1, 2) = sErreur 'ajouter cause de l'erreur dans la colonne de designation
aOut(1, 3) = sErreur 'ajouter cause de l'erreur dans la colonne de designation 24/06/2025
End Ifokay pour le fichier de 16:22 !
Le double-clicque dans le tableau1, un double-clicque dans la colonne "Honda Original" (listcolumn1 mais physiquement colonne 2) est ignoré, mais dans fonctionne pour les 14 listcolumns/columns suivantes (jusqu'à 10-99Fr, inclu). C'est pour cette raison que j'avais choisi la colonne "New_Ref_Honda", mais quand vous préférez "honda Original", pas de problèmes !
Set iSect = Intersect(Target, LO.DataBodyRange.Offset(, 1).Resize(, 14)) ' on a fait ce doubleclick dans une cellule des premières 15 colonnes, sauf la première,du tableau ? oui, c'est ça. papicx 20/06/2025
oei, la formule de la colonne comptait dans un fichier "'D:\C_X_Pieces_Honda\honda-2025-h-bsalv-2025-06-20_D.xlsb'!",pas dans le fichier actuel, bizarre... . Bon, maintenant, la formule utilise le tableau "TBL_Images" de ce fichier ! On verra plus tard si cela est okay.
Bon, l'userform "RechercherHonda" veut une matrice dans son listbox et en cas d'erreur, vous voulez voir la cause de l'erreur dans la 2ème colonne (=index 2 pour compliquer les choses). Donc c'est normal qu'il y a une ligne (=ubound(x)=1) mais le plus important, c'est que la colonne 5 (=index 4) est vide, donc il n'y a pas un numéro du listrow et si on clicque dessus, la macro "ListBoxResultat_Click" refusera de sauter vers l'userform "ModificationHonda"
Dans le formulaire ModifierHonda, serait il possible d'afficher le numéro de la ligne de la feuille et non celle du tableau ?
Oei, pour moi, le "listrow" est plus important que le "row", on peut déplacer le tableau à n'importe quelle place de cette feuille et même une autre feuille, on ne doit rien changer en VBA. Bon, compromis, on utilisera le numéro de la ligne comme "text" et le numéro du listrow comme "tag" du "TextboxNumLigne et la différence (décalage) sera le numéro de la ligne des entêtes du tableau1. Mais attention, je dois utiliser partout ce tag maintenant, donc au moment où je copie quelque chose du tableau vers l'userform ou vice versa !!!
oui, c'est ça. "ou bien"
attention, svp, reprendre mon fichier d'il y a quelques minutes, j'ai mis à jour des références.
merci, au pire, ce n'est pas grave.
re,
j'espère que je n'ai pas oublié quelque part quelque chose ...
Bonjour,
Je viens de voir les explications du bug.
ce bug "80123m", au bout de la fonction "f_Honda" (module6), on a ceci, ce redim après une erreur créait une matrice de 4 colonnes au lieu de 5 avec ce ReDim aOut(1 To 1, 1 To 4)
J'avais bien vu que le texte d'erreur ne s'affichait pas dans la colonne désignation, j'ai corrigé, mais je n'ai pas eu l'idée de modifier le 4 en 5 juste au dessus.
pourtant, j'en ai fait des tests en changeant une ligne à la fois (pour pouvoir revenir facilement en arrière si ça plantait).
la colonne des ref est Ok à présent.
ce qui est curieux, c'est que dans le TBL_Images certaines lignes ont un Listrow à zéro et pourtant le formulaire affiche bien les photos.
Ça ne me dérange pas plus que ça, du moment que ça fonctionne...
C'est pour cette raison que j'avais choisi la colonne "New_Ref_Honda", mais quand vous préférez "honda Original", pas de problèmes !
en fait non, je pensais corriger une erreur.
J'ai remis la ligne d'origine conçue par vous en fonction.
Private Sub ListBoxResultat_Click()
.../...
Ligne_ModificationHonda = i 'assigner cette valeur
Application.Goto Range("tableau1").Cells(i, 3) 'se déplacer vers cette ligne en colonne "New_Ref_Honda" 25/06/2025 (remis le code d'origine)
' Application.Goto Range("tableau1").Cells(i, 1) 'se déplacer vers cette ligne en colonne "HondaOrigine" 24/06/2024et dans la feuille3 "Honda", j'ai mis " LO.DataBodyRange.Offset(, 2).Resize(, 10)) " pour ignorer les 2 premières colonnes.
Cela me permet de modifier ces 2 premières colonnes depuis le tableau sans risquer de déclencher le formulaire.
J'espère que les codes sont cohérents entre-eux.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim iSect As Range
Dim LO: Set LO = Me.Range("Tableau1").ListObject
Set iSect = Intersect(Target, LO.DataBodyRange.Offset(, 2).Resize(, 10)) ' on a fait ce doubleclick dans une cellule des colonnes 2 à 10 (colonne M / 10-96Fr), du tableau. papicx 25/06/2025
Bonjour BsAlv, c'est super bien, ça avance !
oup's, la recherche ne fonctionne pas correctement dans le cas suivant :
quand sur une ligne du tableau, la cellule Ref_Origine est vide, le code ne va pas chercher dans la colonne New_Ref_Honda.
et du coup, bah on a une recherche infructueuse alors que la ref existe dans l'autre colonne.
Limite, il aurait fallu faire l'inverse. D'abord rechercher dans New_Ref_Honda et si vide, continuer dans la ref d'origine.
Mais comme il y a aussi qq lignes de vides en New_Ref_Honda...
J'aurai bien tenté qq corrections de ligne, mais comme je n'arrive pas à saisir comment ça fonctionne... (un peu, mais tellement peu... )
On a le cas pour la ref 53223 (ou tapez "porte" en désignation pour en avoir plusieurs).
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/minuscules)
If j = 1 And b Then 'c'est déjà okay pour Honda Original, donc inutile de vérifier New_Ref_Honda,
j = 2 'sursauter New_honda
Else
If Not b Then Exit For 'si drapeau est déjà faux, inutile de continuer
End If
End Ifedit 12h10
J'ai tenté ça comme correction. Je ne sais pas si c'est propre, mais ça semble fonctionner correctement.
' j = 2 'sursauter New_honda ' mis en commentaire par papicx 25/06/2025
' Else ' mis en commentaire par papicx 25/06/2025il reste ça comme petite, mais toute petite anomalie :
Le compteur de recherche en bas du formulaire de recherche affiche " 1 " au lieu de " 0 " quand il y aucune référence trouvée.
J'ai élargi le formulaire de recherche et les colonnes pour que les références les plus longues soient affichées correctement, idem pour les numéros de ligne.
nouveau fichier. J'ai mis à jour avec les photos qui vont bien une 30ène de références.
gros ménage fait dans les références, grâce au formulaire de recherche !
MERCI BEAUCOUP
est-il possible que la recherche soit "ET" entre les textbox désignation et dimensions pour retreindre les correspondances ?
On est d'accord
- qu'il faut maintenir le "OU BIEN" entre les 2 champs des références.
- que le champs 'Dimension" ne sera pas forcément renseigné.
Je vais voir si je trouve par moi-même comment il faut faire...
Edit 15h20
Bon, bah voilà... mes compétences s'arrêtent là.
Ce code est dans la version du 27/06/2025-test-ET qui est en bas de page.
Merci d'avance
Function f_Honda(sRef As String, sDesign As String, sDim As String)
Dim Arr, NDX(1 To 5), i, s, arr1(1 To 4), aOut, sErreur As String
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 _original 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 4 'boucler ces 4 colonnes 27/06/2025
For j = 1 To 3 'boucler les 3 première colonnes 27/0/2025
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/minuscules)
If j = 1 And b Then 'c'est déjà okay pour Honda Original, donc inutile de vérifier New_Ref_Honda,
' j = 2 'sursauter New_honda ' mis en commentaire par papicx 25/06/2025
' Else ' mis en commentaire par papicx 25/06/2025
If Not b Then Exit For 'si drapeau est déjà faux, inutile de continuer
End If
End If
' condition ET entres les 3 premières colonnes et la colonne "Dimension" 27/06/2025
For k = 4 To 4 'boucler la 4 ème colonne
If arr1(k) <> "" Then ' la valeur du filtre n'est pas vide
b = (InStr(1, Arr(i, NDX(k)), arr1(k), 1) > 0) 'la valeur se trouve dans cette cellule (en ignorant majuscules/minuscules)
If k = 1 And b Then '
If Not b Then Exit For ' si drapeau est déjà faux, inutile de continuer
End If
End If
' FIN de la recherche dans la colonne "Dimension"
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)) 'redimensionner 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 5) 'redimensionner matrice avec bon format !!! 5 colonnes au lieu de 4 !!!! 24/06/2025
aOut(1, 3) = sErreur 'ajouter cause de l'erreur dans la colonne de designation 24/06/2025
End If
f_Honda = aOut
End Functionmon fichier du jour.
ajout du nombre de photos dans le UF Modifier
modification du module3
Bonjour à tous,
Bon, j'ai réussi à refaire fonctionner le formulaire pour qu'il affiche "aucune" à la place de "1" quand il n'a rien trouvé.
J'ai aussi réussi à faire en sorte qu'il cherche bien dans les 2 colonnes des références, tout simplement en désactivant 2 lignes dans le module6.
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/minuscules)
If j = 1 And b Then 'c'est déjà okay pour Honda Original, donc inutile de vérifier New_Ref_Honda,
j = 2 'sursauter New_honda
' Else ' mis en commentaire par papicx 03/07/2025
' If Not b Then Exit For 'si drapeau est déjà faux, inutile de continuer ' mis en commentaire par papicx 03/07/2025
End If
End If
Nextil reste cette question à éventuellement résoudre, demandée le 27 juin.
Serait-il possible que la recherche soit "ET" entre les textbox désignation et dimensions pour retreindre les correspondances ?
On est d'accord
• qu'il faut maintenir le "OU BIEN" entre les 2 champs des références.
• que le champs 'Dimension" ne sera pas forcément renseigné.
Le but est, par exemple, de chercher avec le mot "joint" dans la désignation et "8" dans les dimensions.
Merci d'avance.