XL 2021 Formule RechercheX et VBA

thunder23 · 6 Juillet 2024

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 😉

wDog66 · 6 Juillet 2024

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+

thunder23 · 6 Juillet 2024

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+

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+

Gégé-45550 · 6 Juillet 2024

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+

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

thunder23 · 6 Juillet 2024

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

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

Gégé-45550 · 6 Juillet 2024

thunder23 à dit:
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

Bonjour,
elles le seront à chaque fois que votre feuille sera recalculée

thunder23 · 8 Juillet 2024

Gégé-45550 à dit:
Bonjour,
elles le seront à chaque fois que votre feuille sera recalculée

Bonjour,
en quelque sorte oui mais aussi en ouverture du fichier

Gégé-45550 · 8 Juillet 2024

thunder23 à dit:
Bonjour,
en quelque sorte oui mais aussi en ouverture du fichier

Bonjour,
bien sûr !

thunder23 · 8 Juillet 2024

Gégé-45550 à dit:
Bonjour,
bien sûr !

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 😆

XL 2021 Formule RechercheX et VBA

thunder23

XLDnaute Occasionnel

Pièces jointes

wDog66

XLDnaute Impliqué

thunder23

XLDnaute Occasionnel

Gégé-45550

XLDnaute Accro

thunder23

XLDnaute Occasionnel

Gégé-45550

XLDnaute Accro

thunder23

XLDnaute Occasionnel

Gégé-45550

XLDnaute Accro

thunder23

XLDnaute Occasionnel

Discussions similaires

XL 2021 Formule RechercheX et VBA

XLDnaute Occasionnel

Pièces jointes

XLDnaute Impliqué

XLDnaute Occasionnel

XLDnaute Accro

XLDnaute Occasionnel

XLDnaute Accro

XLDnaute Occasionnel

XLDnaute Accro

XLDnaute Occasionnel

Discussions similaires

Privacy & Transparency

Privacy & Transparency