Rechercher valeur par boucle plutot que par vlookup

Le 11/08/2015 à 17:35

Bonjour à tous,

Je me permets de revenir vers vous afin d'avoir de plus amples informations sur une procédure à suivre.

Dans l'un de mes fichier, je réalise par le biais de vba des vlookup me permettant de copier coller des données à partir d'une valeur de référence entre deux feuilles : Cf. code ci-dessous.

   For i = 2 To DERNIERELIGNEUAI

    Range("C" & i).Value = Objmel
    Range("D" & i).Value = "Aucun"
    Range("E" & i).Value = Rep
    Range("F" & i).Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[4],Avenant!C[-5]:C[-4],2,FALSE)"
    Range("G" & i).Select
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(RC[3],'Carte des formations'!C[-6]:C[-5],2,FALSE)"
    Range("H" & i).Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[2],TEST!C[-7]:C[-5],2,FALSE)"

    Next

    Range("F2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    MsgBox "L'import des données de fichier dans le tableau Excel a fonctionné", vbCritical + vbOKOnly, "Répartition..."
End Sub

Une boucle serait plus pratique puisque cela m'éviterai de passer par deux étapes : recherchev + copier coller valeur.

Je me permets donc de vous solliciter afin d'obtenir votre aide.

D'avance je vous remercie.

Le 11/08/2015 à 17:55

Bonjour

Sans fichier pour vérifier si les résultats sont justes

Sub Test()
Dim DERNIERELIGNEUAI As Long, I As Long

  DERNIERELIGNEUAI = 10
  Range("C2").Value = Objmel
  Range("D2").Value = "Aucun"
  Range("E2").Value = Rep
  Range("F2").FormulaR1C1 = "=VLOOKUP(RC[4],Avenant!C[-5]:C[-4],2,FALSE)"
  Range("G2").FormulaR1C1 = "=VLOOKUP(RC[3],'Carte des formations'!C[-6]:C[-5],2,FALSE)"
  Range("H2").FormulaR1C1 = "=VLOOKUP(RC[2],TEST!C[-7]:C[-5],2,FALSE)"
  Range("C2:H2").AutoFill Destination:=Range("C2:H2").Resize(DERNIERELIGNEUAI - 1, 6), Type:=xlFillSeries
  With Range("C2:H2").Resize(DERNIERELIGNEUAI - 1, 6)
    .Value = .Value
  End With
MsgBox "L'import des données de fichier dans le tableau Excel a fonctionné", vbCritical + vbOKOnly, "Répartition..."
End Sub
Le 11/08/2015 à 18:22

Bonjour le fil, bonjour le forum,

Je n'ai pas dû comprendre la même chose... Voici ma proposition :

Public Sub Macro1()
Dim I As Integer
Dim R As Range

For I = 2 To DERNIERELIGNEUAI
    Range("C" & I).Value = Objmel
    Range("D" & I).Value = "Aucun"
    Range("E" & I).Value = Rep
    Set R = Sheets("Avenant").Columns(1).Find(Cells(I, "J").Value, , xlValues, xlWhole)
    If Not R Is Nothing Then Cells(I, "F").Value = R.Offset(0, 1).Value: Set R = Nothing
    Set R = Sheets("Carte des formations").Columns(1).Find(Cells(I, "J"), , xlValues, xlWhole)
    If Not R Is Nothing Then Cells(I, "G").Value = R.Offset(0, 1).Value: Set R = Nothing
    Set R = Sheets("TEST").Columns(1).Find(Cells(I, "J"), , xlValues, xlWhole)
    If Not R Is Nothing Then Cells(I, "H").Value = R.Offset(0, 1).Value: Set R = Nothing
Next I
MsgBox "L'import des données de fichier dans le tableau Excel a fonctionné", vbCritical + vbOKOnly, "Répartition..."
'Range(Range("F2"), Range("F2").End(xlToRight).End(xlDown)).Copy
'Range("F2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
'   :=False, Transpose:=False
End Sub

@Jejeaunet : Évite autant que le le peux les Select inutiles qui ne font que ralentir l'exécution du code. Les deux dernières lignes (que j'ai transformé en commentaires) font la même chose que ton code sans aucun Select...

Le 12/08/2015 à 09:03

Bonjour ThauThème,

Ta solution fonctionne très bien. Tu as très bien compris ma demande.

J'essaye de comprendre comment fonctionne le bout de code mais je peine un petit peu. Étant en début d'apprentissage de la phrase de codage, il est important pour moi de saisir les logiques pour les ré-appliquer quand cela est nécessaire et d'éviter de poster tous les 4 matins dès que je suis bloqué.

Peux tu donc m'expliquer la logique de ton code.

Je te remercie grandement pour ton coup de pouce !

Bonne journée,

Le 15/08/2015 à 13:58

Bonjour le fil, bonjour le forum,

Désolé p[our le retard mais je me suis absenté ces trois derniers jours...

La fonction Find correspond exactement à la boîte de dialogue Rechercher (et remplacer) d'Excel. Elle renvoie donc une cellule (objet de type Range) et c'est pour cela que l'on utilise Set pour la définir. Tout comme la boîte de dialogue elle possède de nombreux arguments et je n'en ai utilisée que deux (Regarder dans : les Valeurs : xlValues et la Totalité du contenu de la cellule : xlWhole.[/color]

Dim R As Range / => déclare la variable R

Set R = / => va définir la recherche

Sheets("Avenant").Columns(1) / => indique que la recherche se fait uniquement dans la colonne 1 (=A) de l'onglet "Avenant")

.Find(Cells(I, "J").Value / => indique la valeur cherchée

, , xlValues / => indique que la recherche se fait dans les valeurs (non pas dans les formules)

, xlWhole) / => indique que la recherche se fait sur la valeur entière (non pas sur une partie)

Une fois la recherche établie elle va renvoyer soit "rien" (Nothing) soir la première cellule contenant la valeur cherchée. C'est pour cela que l'on utilise la syntaxe :

If Not R Is Nothing Then / => si il existe au moins une occurrence R trouvée

Cells(I, "F").Value = R.Offset(0, 1).Value / => récupère dans la cellule ligne I colonne F la valeur de R décalée d'une colonne à droite (Offset(0, 1) / voir l'aide sur Offset)

: Set R = Nothing / => vide la variable R pour la prochaine recherche (les deux point (:) permettent d'écrire deux actions sur une même ligne)

N'hésite pas à utiliser l'aide VBA en sélectionnant un mot clé du code puis en appuyant sur la touche [F1]. Les explications sont claires et souvent étayées d'exemple. Taper Find.Range pour l'aide sur la fonction Find. Quand il faut trouver toutes les occurrences d'un mot on la combine avec FindNext. Mais ton cas ne le demandait pas...

Le 31/08/2015 à 11:32

Bonjour,

De retour de vacances, je te remercie pour l'ensemble des explications données. Je prends sous forme de notes et garde de côté pour mes éventuelles futures macro.

Encore un grand merci pour avoir pris le temps de tout m'expliquer.

Bonne journée.

Rechercher des sujets similaires à "rechercher valeur boucle plutot que vlookup"