XL 2021 Formule RechercheX et VBA

thunder23

thunder23

XLDnaute Occasionnel
Bonjour le forum,

J'ai un fichier Excel à mettre à jour où des valeurs sont à rechercher avec une formule rechercheX avec une liaison avec un autre fichier. En fait quand je dois ajouter des produits avec un code article, je veux que ça me trouve la valeur par cette formule car le fichier distant est à jour régulièrement.

J'ai mis un fichier pour mieux comprendre se que je recherche.

Merci d'avance pour vos retours ;)
 

Pièces jointes

  • testformule.xlsm
    19.2 KB · Affichages: 4
Trier par date Trier par votes
wDog66

wDog66

XLDnaute Occasionnel
Bonjour thunder23

Pourquoi ne pas utiliser une requête SQL avec ADO plutôt

Pour activer la référence ADO :
Cliquez sur Outils > Références.
Cochez Microsoft ActiveX Data Objects x.x Library (la version peut varier).

Pour utiliser ADO afin d'accéder aux données du fichier externe :
VB: 
Sub RechercherReferenceSansOuvrir()
    Dim cn As Object
    Dim rs As Object
    Dim cheminFichier As String
    Dim feuille As String
    Dim codeArticle As String
    Dim reference As String
    Dim requeteSQL As String
    
    ' Définir les variables
    cheminFichier = "C:\Nomdudossier\nomdufichier.xlsx"
    feuille = "Feuil1$" ' Nom de la feuille avec un $ à la fin
    codeArticle = "CODE123" ' Remplacer par le code article souhaité
    
    ' Créer la connexion ADO
    Set cn = CreateObject("ADODB.Connection")
    cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & cheminFichier & ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"
    
    ' Définir la requête SQL pour trouver la référence correspondant au code article
    requeteSQL = "SELECT ref FROM [" & feuille & "] WHERE [code article] = '" & codeArticle & "'"
    
    ' Exécuter la requête
    Set rs = CreateObject("ADODB.Recordset")
    rs.Open requeteSQL, cn, 1, 1
    
    ' Vérifier si des résultats ont été trouvés
    If Not rs.EOF Then
        reference = rs.Fields("ref").Value
    Else
        reference = "Non trouvé"
    End If
    
    ' Afficher la référence (ou l'insérer dans une cellule de votre choix)
    MsgBox "La référence pour le code article " & codeArticle & " est : " & reference
    
    ' Fermer la connexion
    rs.Close
    cn.Close
    Set rs = Nothing
    Set cn = Nothing
End Sub

A+
 
Vote positif 0 Vote négatif
thunder23

thunder23

XLDnaute Occasionnel
wDog66 à dit:
Bonjour thunder23

Pourquoi ne pas utiliser une requête SQL avec ADO plutôt

Pour activer la référence ADO :
Cliquez sur Outils > Références.
Cochez Microsoft ActiveX Data Objects x.x Library (la version peut varier).

Pour utiliser ADO afin d'accéder aux données du fichier externe :
VB: 
Sub RechercherReferenceSansOuvrir()
    Dim cn As Object
    Dim rs As Object
    Dim cheminFichier As String
    Dim feuille As String
    Dim codeArticle As String
    Dim reference As String
    Dim requeteSQL As String
   
    ' Définir les variables
    cheminFichier = "C:\Nomdudossier\nomdufichier.xlsx"
    feuille = "Feuil1$" ' Nom de la feuille avec un $ à la fin
    codeArticle = "CODE123" ' Remplacer par le code article souhaité
   
    ' Créer la connexion ADO
    Set cn = CreateObject("ADODB.Connection")
    cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & cheminFichier & ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"
   
    ' Définir la requête SQL pour trouver la référence correspondant au code article
    requeteSQL = "SELECT ref FROM [" & feuille & "] WHERE [code article] = '" & codeArticle & "'"
   
    ' Exécuter la requête
    Set rs = CreateObject("ADODB.Recordset")
    rs.Open requeteSQL, cn, 1, 1
   
    ' Vérifier si des résultats ont été trouvés
    If Not rs.EOF Then
        reference = rs.Fields("ref").Value
    Else
        reference = "Non trouvé"
    End If
   
    ' Afficher la référence (ou l'insérer dans une cellule de votre choix)
    MsgBox "La référence pour le code article " & codeArticle & " est : " & reference
   
    ' Fermer la connexion
    rs.Close
    cn.Close
    Set rs = Nothing
    Set cn = Nothing
End Sub

A+
Cliquez pour agrandir...
Bonjour @wDog66,

Alors le SQL je ne connais pas du tout néanmoins ton code est bien expliqué ;)

En fait j'ai un peu caricaturé le fichier test car le code où je veux l'agrémenter est dans un userform avec plusieurs valeurs et une feuille avec pas moins de 60 colonnes et ça ne concernerait que 4 dispersé dans le tableau.
Voilà le code en question si ça peut te donner une idée : ;)

VB: 
'Pour le bouton Ajouter
Private Sub CommandButton_ajouter_Click()
On Error Resume Next
    If [accès] = 3 Then
    Sheets("Base").Visible = True
    End If
    Sheets("Base").Select
    Dim L As Integer
    If MsgBox("Confirmer l'ajout de cet article?", vbYesNo, "Demande de confirmation d'ajout") = vbYes Then
        L = Sheets("Base").Range("A" & Rows.Count).End(xlUp).Row + 1 'Pour placer le nouvel enregistrement à la première ligne du tableau non vide
        Range("A" & L).Value = TextBox_code.Value
        Range("B" & L).Value = ComboBox_groupe
        Range("C" & L).Value = TextBox1  'titre
        Range("D" & L).Value = TextBox2.Value  'longueur
        Range("E" & L).Value = TextBox3.Value  'largeur
        Range("F" & L).Value = TextBox4.Value  'epaisseur
        Range("G" & L).Value = TextBox5.Value  'densite
        Range("H" & L).Value = TextBox6.Value  'compocol
        Range("I" & L).Value = TextBox7.Value  'compopal
        Range("J" & L).Value = TextBox8.Value  'hauteurcol
        Range("K" & L).Value = TextBox9  'palinter
        Range("L" & L).Value = TextBox10  'colisage
        Range("M" & L).Value = TextBox11  'film
        Range("N" & L).Value = TextBox12.Value  'calG
        Range("O" & L).Value = TextBox13.Value  'calD
        Range("P" & L).Value = TextBox14.Value 'KL
        Range("Q" & L).Value = TextBox15.Value  'Coefficient
        Range("R" & L).Value = TextBox16.Value  'TC
        Range("S" & L).Value = TextBox17.Value  '
        Range("T" & L).Value = TextBox18.Value  ' valeur rechercher à distance
        Range("U" & L).Value = TextBox19.Value  ' valeur rechercher à distance
        Range("V" & L).Value = TextBox20.Value  ' valeur rechercher à distance
        Range("W" & L).Value = TextBox21.Value  '
        Range("X" & L).Value = TextBox22  '
        Range("Y" & L).Value = TextBox23.Value  '
        Range("Z" & L).Value = TextBox24  'valeur rechercher à distance
        Range("AA" & L).Value = TextBox25  '
        Range("AB" & L).Value = TextBox26.Value  '
        Range("AC" & L).Value = TextBox27.Value  '
        Range("AD" & L).Value = TextBox28.Value  '
        Range("AE" & L).Value = TextBox29.Value  '
        Range("AF" & L).Value = TextBox30.Value  '
        Range("AG" & L).Value = TextBox31  '
        Range("AH" & L).Value = TextBox32.Value  '
        Range("AI" & L).Value = TextBox33.Value  '
        Range("AJ" & L).Value = TextBox34.Value  '
        Range("AK" & L).Value = TextBox35.Value  'Largproderi
        Range("AL" & L).Value = TextBox36.Value  'nbpxentrant
        Range("AM" & L).Value = TextBox37.Value  'Vitlamescie
        Range("AN" & L).Value = TextBox38 '
        Range("AO" & L).Value = TextBox39 '
        Range("AP" & L).Value = TextBox40 '
        Range("AQ" & L).Value = TextBox41 '
        Range("AR" & L).Value = TextBox42 '
        Range("AS" & L).Value = TextBox43 '
        Range("AT" & L).Value = TextBox44 '
        Range("AU" & L).Value = TextBox45 '
        Range("AV" & L).Value = TextBox46 '
        Range("AW" & L).Value = TextBox47 '
        Range("AX" & L).Value = TextBox48 '
        Range("AY" & L).Value = TextBox49 '
        Range("AZ" & L).Value = TextBox50 '
        Range("BA" & L).Value = TextBox51 '
        Range("BB" & L).Value = TextBox52 '
        Range("BC" & L).Value = TextBox53
        Range("BD" & L).Value = TextBox54
        Range("BE" & L).Value = TextBox55 'toleranceVV
        Range("BF" & L).Value = TextBox56 'Flèche
        Range("BG" & L).Value = TextBox57 '
        Range("BH" & L).Value = TextBox58 '
        Range("BI" & L).Value = TextBox59 '
        Range("BJ" & L).Value = TextBox60 '
        Range("BK" & L).Value = CDate(Controls("TextBox61").Value) 'date
        Range("BL" & L).Value = TextBox62 'commentaire
    End If
    If [accès] = 3 Then
    Sheets("Base").Visible = False
    End If
    Sheets("Accueil").Select
    MsgBox " Ajout effectué !", 0 + 64, "INFORMATION"
End Sub

A+
 
Vote positif 0 Vote négatif
Gégé-45550

Gégé-45550

XLDnaute Accro
thunder23 à dit:
Bonjour @wDog66,

Alors le SQL je ne connais pas du tout néanmoins ton code est bien expliqué ;)

En fait j'ai un peu caricaturé le fichier test car le code où je veux l'agrémenter est dans un userform avec plusieurs valeurs et une feuille avec pas moins de 60 colonnes et ça ne concernerait que 4 dispersé dans le tableau.
Voilà le code en question si ça peut te donner une idée : ;)

VB: 
'Pour le bouton Ajouter
Private Sub CommandButton_ajouter_Click()
On Error Resume Next
    If [accès] = 3 Then
    Sheets("Base").Visible = True
    End If
    Sheets("Base").Select
    Dim L As Integer
    If MsgBox("Confirmer l'ajout de cet article?", vbYesNo, "Demande de confirmation d'ajout") = vbYes Then
        L = Sheets("Base").Range("A" & Rows.Count).End(xlUp).Row + 1 'Pour placer le nouvel enregistrement à la première ligne du tableau non vide
        Range("A" & L).Value = TextBox_code.Value
        Range("B" & L).Value = ComboBox_groupe
        Range("C" & L).Value = TextBox1  'titre
        Range("D" & L).Value = TextBox2.Value  'longueur
        Range("E" & L).Value = TextBox3.Value  'largeur
        Range("F" & L).Value = TextBox4.Value  'epaisseur
        Range("G" & L).Value = TextBox5.Value  'densite
        Range("H" & L).Value = TextBox6.Value  'compocol
        Range("I" & L).Value = TextBox7.Value  'compopal
        Range("J" & L).Value = TextBox8.Value  'hauteurcol
        Range("K" & L).Value = TextBox9  'palinter
        Range("L" & L).Value = TextBox10  'colisage
        Range("M" & L).Value = TextBox11  'film
        Range("N" & L).Value = TextBox12.Value  'calG
        Range("O" & L).Value = TextBox13.Value  'calD
        Range("P" & L).Value = TextBox14.Value 'KL
        Range("Q" & L).Value = TextBox15.Value  'Coefficient
        Range("R" & L).Value = TextBox16.Value  'TC
        Range("S" & L).Value = TextBox17.Value  '
        Range("T" & L).Value = TextBox18.Value  ' valeur rechercher à distance
        Range("U" & L).Value = TextBox19.Value  ' valeur rechercher à distance
        Range("V" & L).Value = TextBox20.Value  ' valeur rechercher à distance
        Range("W" & L).Value = TextBox21.Value  '
        Range("X" & L).Value = TextBox22  '
        Range("Y" & L).Value = TextBox23.Value  '
        Range("Z" & L).Value = TextBox24  'valeur rechercher à distance
        Range("AA" & L).Value = TextBox25  '
        Range("AB" & L).Value = TextBox26.Value  '
        Range("AC" & L).Value = TextBox27.Value  '
        Range("AD" & L).Value = TextBox28.Value  '
        Range("AE" & L).Value = TextBox29.Value  '
        Range("AF" & L).Value = TextBox30.Value  '
        Range("AG" & L).Value = TextBox31  '
        Range("AH" & L).Value = TextBox32.Value  '
        Range("AI" & L).Value = TextBox33.Value  '
        Range("AJ" & L).Value = TextBox34.Value  '
        Range("AK" & L).Value = TextBox35.Value  'Largproderi
        Range("AL" & L).Value = TextBox36.Value  'nbpxentrant
        Range("AM" & L).Value = TextBox37.Value  'Vitlamescie
        Range("AN" & L).Value = TextBox38 '
        Range("AO" & L).Value = TextBox39 '
        Range("AP" & L).Value = TextBox40 '
        Range("AQ" & L).Value = TextBox41 '
        Range("AR" & L).Value = TextBox42 '
        Range("AS" & L).Value = TextBox43 '
        Range("AT" & L).Value = TextBox44 '
        Range("AU" & L).Value = TextBox45 '
        Range("AV" & L).Value = TextBox46 '
        Range("AW" & L).Value = TextBox47 '
        Range("AX" & L).Value = TextBox48 '
        Range("AY" & L).Value = TextBox49 '
        Range("AZ" & L).Value = TextBox50 '
        Range("BA" & L).Value = TextBox51 '
        Range("BB" & L).Value = TextBox52 '
        Range("BC" & L).Value = TextBox53
        Range("BD" & L).Value = TextBox54
        Range("BE" & L).Value = TextBox55 'toleranceVV
        Range("BF" & L).Value = TextBox56 'Flèche
        Range("BG" & L).Value = TextBox57 '
        Range("BH" & L).Value = TextBox58 '
        Range("BI" & L).Value = TextBox59 '
        Range("BJ" & L).Value = TextBox60 '
        Range("BK" & L).Value = CDate(Controls("TextBox61").Value) 'date
        Range("BL" & L).Value = TextBox62 'commentaire
    End If
    If [accès] = 3 Then
    Sheets("Base").Visible = False
    End If
    Sheets("Accueil").Select
    MsgBox " Ajout effectué !", 0 + 64, "INFORMATION"
End Sub

A+
Cliquez pour agrandir...
Bonjour,
vous pouvez utiliser la fonction RechercheX dans votre code VBA de cette manière par exemple :
VB: 
Textbox18.Value = Application.WorksheetFunction.XLookup(Sheets("Feuil1").Range("C16"), Sheets("Base").Range("A:A"), Sheets("Base").Range("B:B"), "n/a", 0)
en adaptant les paramètres, en particulier Sheets("Base").Range("A:A") et Sheets("Base").Range("B:B") au chemin d'accès à votre "vrai" fichier de données.
Cordialement
 
Vote positif 0 Vote négatif
thunder23

thunder23

XLDnaute Occasionnel
Gégé-45550 à dit:
Bonjour,
vous pouvez utiliser la fonction RechercheX dans votre code VBA de cette manière par exemple :
VB: 
Textbox18.Value = Application.WorksheetFunction.XLookup(Sheets("Feuil1").Range("C16"), Sheets("Base").Range("A:A"), Sheets("Base").Range("B:B"), "n/a", 0)
en adaptant les paramètres, en particulier Sheets("Base").Range("A:A") et Sheets("Base").Range("B:B") au chemin d'accès à votre "vrai" fichier de données.
Cordialement
Cliquez pour agrandir...
Bonjour @Gégé-45550,

Ok d'accord merci pour votre retour par contre est-ce que si les valeurs dans le fichier distant qui sont modifiées le seront également dans le miens ?

Cordialement
 
Vote positif 0 Vote négatif
thunder23

thunder23

XLDnaute Occasionnel
Gégé-45550 à dit:
Bonjour,
bien sûr !
Cliquez pour agrandir...
Re,

Le code initial pour ajouter sur mon fichier par l'USF est sur le message #3, la seule chose que je souhaite c'est que ça me fasse comme si on ajoutait la formule RECHERCHEX dans la cellule correspondante à la TextBox sur un autre fichier distant et que ça se mette à jour l'or de l'ouverture.
Désolé pour mon dernier message car pas très explicit je l'avoue 😆
 
Vote positif 0 Vote négatif

Discussions similaires

V
  • Question
Microsoft 365 RECHERCHEX a disparu !!
Réponses
5
Affichages
734
Viniasco
V
A
  • Résolu(e)
XL 2016 Recherchex
Réponses
2
Affichages
359
Phil69970
Phil69970
M
  • Question
Microsoft 365 RechercheX et exaequo
2
Réponses
16
Affichages
892
matmac
M
B
  • Question
Microsoft 365 VBA optimisation chargement listview
Réponses
7
Affichages
212
barry white
B
V
  • Résolu(e)
Microsoft 365 RechercheX en recherchant une valeur qui "contient"
Réponses
7
Affichages
819
vince2k
V
Electron24
  • Résolu(e)
Microsoft 365 Formule RECHERCHEV ou RECHERCHEX
Réponses
13
Affichages
844
Electron24
Electron24
D
  • Question
Microsoft 365 Formule ou VBA
Réponses
6
Affichages
223
Didier03
D
F
  • Question
Microsoft 365 problème formule dans tableau alimenté en VBA
Réponses
1
Affichages
370
merinos
merinos
M
  • Résolu(e)
Microsoft 365 Problème Excel Macros Liaison Ppt
Réponses
9
Affichages
111
Phil69970
Phil69970
Z
  • Question
Microsoft 365 Figer les prix Produits vendu tableau2, après mise à jour prix dans Tableau 1
2
Réponses
23
Affichages
1 K
sousou
sousou

Membres actuellement en ligne

5 membres et 26 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
313 769
Messages
2 102 234
Membres
108 181
dernier inscrit
Chr1sD