• Initiateur de la discussion Initiateur de la discussion sircroco
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S

sircroco

Guest
Bonjour,

Je rencontre un bug lorsque j'exécute ma Macro la "rechercheV" ne s'applique pas totalement sur la feuil1... une personne veut bien m'aider à réparer ça ? 😀

Le fichier est en PJ:
La feuil1 est la feuille où s'exécute la macro et la feuil2 est la base de donnée (la Source)

Mes sincères salutations.
 

Pièces jointes

Hello

si, ta macro se déroule bien jusqu'en bas.. c'est juste qu'elle ne trouve pas la dernière valeur

une autre facon de faire
VB:
Sub test()
Application.EnableEvents = False
Range("I2:I" & Rows.Count).ClearContents
Dim TabResult() As Variant
With Sheets("Feuil1")
    Fin = .Range("B" & .Rows.Count).End(xlUp).Row
    TabResult = .Range("B2:B" & Fin).Value
End With
With Sheets("feuil2")
    For i = LBound(TabResult, 1) To UBound(TabResult, 1)
        Set ici = .Range("A:A").Find(TabResult(i, 1), lookat:=xlWhole)
        If Not ici Is Nothing Then
            TabResult(i, 1) = .Range("D" & ici.Row)
        ElseIf Range("D" & i) <> "" Then
            TabResult(i, 1) = "--"
        Else
            TabResult(i, 1) = ""
        End If
    Next i
End With
With Sheets("Feuil1")
    .Range("I2").Resize(UBound(TabResult, 1)) = TabResult
End With
Application.EnableEvents = True
End Sub
 
Bonjour sircroco, vgendron,

Voici 2 solutions dans ces posts #3 et #4.

Celle-ci sans Dictionary entre simplement la fonction RECHERCHEV en colonne I (au format standard) :
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim feuille As String, r As Range
feuille = "Feuil2" 'nom de la feuille source, à adapter
Set r = Intersect(Target.EntireRow, Range("I2:I" & Rows.Count), UsedRange)
If r Is Nothing Then Exit Sub
If FilterMode Then ShowAllData 'si la feuille est filtrée
Application.EnableEvents = False
For Each r In r.Areas 'si entrées multiples (copier-coller)
    r = "=IFERROR(VLOOKUP(RC[-7],'" & feuille & "'!C[-8]:C[-5],4,0),""--"")"
Next
Application.EnableEvents = True
End Sub
Fichier joint.

A+
 

Pièces jointes

Re,

Cette 2ème solution avec Dictionary est plus rapide s'il y a beaucoup de lignes dans la 1ère feuille :
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim feuille As String, r As Range
feuille = "Feuil2" 'nom de la feuille source, à adapter
Set r = Intersect(Target.EntireRow, Range("I2:I" & Rows.Count), UsedRange)
If r Is Nothing Then Exit Sub
If FilterMode Then ShowAllData 'si la feuille est filtrée
Application.EnableEvents = False
For Each r In r.Areas 'si entrées multiples (copier-coller)
    r = "=MaRecherche(RC[-7],'" & feuille & "'!C[-8]:C[-5])"
Next
Application.EnableEvents = True
End Sub
Le code de la fonction dans Module1 :
Code:
Public d As Object 'mémorise la variable pour gagner du temps

Function MaRecherche(v As String, plage As Range)
Dim t, col As Integer, i As Long
If d Is Nothing Then
    t = Intersect(plage.Parent.UsedRange.EntireRow, plage)
    col = UBound(t, 2)
    Set d = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(t)
        If Not d.exists(CStr(t(i, 1))) Then d(CStr(t(i, 1))) = CStr(t(i, col))
    Next
End If
MaRecherche = ""
If v <> "" Then If d.exists(v) Then MaRecherche = d(v) Else MaRecherche = "--"
End Function
Et dans le code de Feuil2 :
Code:
Private Sub Worksheet_Deactivate()
Set d = Nothing
[A1] = [A1] 'force le recalcul des fonctions en Feuil1
End Sub
Fichier joint.

Edit : ajouté des CStr par sécurité.

A+
 

Pièces jointes

Dernière édition:
Merci beaucoup de votre investissement a vous deux, concernant ladeuxieme solution puis-je savoir la signification de RC -8 C-8 etc ? Et si j’ai plusieurs recherche V a faire de ce type comment puis-je integree les autres dans le code ?
 
Re,

Pour voir la différence exécutez cette macro sur chacun des 2 fichiers :
Code:
Sub test()
Dim t
t = Timer
Feuil2.[A:A].Copy Feuil1.[B1] 'copier-coller
MsgBox Timer - t
End Sub
- sans Dictionary => 105 secondes

- avec Dictionary => 1, 4 seconde, y a pas photo.

A+
 
Re,
puis-je savoir la signification de RC -8 C-8 etc ? Et si j’ai plusieurs recherche V a faire de ce type comment puis-je integree les autres dans le code ?
La formule qui est entrée en colonne I est en notation R1C1 avec des références de colonnes relatives, renseignez-vous.

Pour faire plusieurs recherches il faut déjà avoir bien compris ce qui a été proposé, respirer un grand coup et plonger.

Et si vous avez vraiment besoin d'un maître-nageur revenez ici.

A+
 
Re,

Restitution de 3 colonnes avec le Dictionary :
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim feuille As String, r As Range
feuille = "Feuil2" 'nom de la feuille source, à adapter
Set r = Intersect(Target.EntireRow, Range("D2:D" & Rows.Count), UsedRange)
If r Is Nothing Then Exit Sub
If FilterMode Then ShowAllData 'si la feuille est filtrée
Application.EnableEvents = False
For Each r In r.Areas 'si entrées multiples (copier-coller)
    r.FormulaR1C1 = "=MaRecherche(RC2,'" & feuille & "'!C1:C4,1)" 'en colonne D
    r.Offset(, 2).FormulaR1C1 = "=MaRecherche(RC2,'" & feuille & "'!C1:C4,2)" 'en colonne F
    r.Offset(, 5).FormulaR1C1 = "=MaRecherche(RC2,'" & feuille & "'!C1:C4,3)" 'en colonne I
Next
Application.EnableEvents = True
End Sub
Les références de colonnes sont maintenant absolues, c'est plus simple.

Quant à la fonction il y a l'argument ordre en plus :
Code:
Public d As Object 'mémorise la variable pour gagner du temps

Function MaRecherche(v As String, plage As Range, ordre As Byte)
Dim t, i As Long
If d Is Nothing Then
    t = Intersect(plage.Parent.UsedRange.EntireRow, plage)
    Set d = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(t)
        If Not d.exists(CStr(t(i, 1))) Then d(CStr(t(i, 1))) = t(i, 2) & Chr(1) & t(i, 3) & Chr(1) & t(i, 4)
    Next
End If
MaRecherche = ""
If v <> "" Then If d.exists(v) Then MaRecherche = Split(d(v), Chr(1))(ordre - 1) Else MaRecherche = "--"
End Function
Fichier (2).

Edit : ajouté des CStr par sécurité.

A+
 

Pièces jointes

Dernière édition:
Bonjour Job75, je vous remercie beaucoup pour m'avoir donné cette solution, j'ai étudié le code même si il reste des choses que je ne comprends pas comme ce qui est fait ligne à ligne dans "Module1", pouvez-vous me dire ce que ça donnerait si on a une deuxième source qui vient alimenter la même feuille, la colonne coloriée en jaune en l'occurence ? Voir fichier en PJ

De plus, si je souhaite coder en VBA via un clique_bouton une formule de multiplication dans la colonne bleu, j'ai fait le test et c'est très lent car la macro que vous aviez conçu pour moi est en interaction.
Est-il possible simplement de mettre votre macro sur un clique_bouton ? comme ça elle s'exécutera lorsque je le désire.

merci de votre généreuse réponse !
 

Pièces jointes

Dernière modification par un modérateur:
Rebonjour merci de votre réponse. Dans l’autre fil de discussion la recherchev est super longue si il y a beaucoup de ligne et c’est le cas en vérité. J’apprécie beaucoup votre utiliation de dictionnaire pour rendre très rapide la rechercheV ça simplifie beaucoup le fichier. c’est pourquoi je souhaite continuer sur cette solution et avoir les réponses à mon dernier post si ça vous dérange pas. Ça sera mon ultime requete.

Cdt
 
Re,

Avec 2 feuilles sources le plus simple est de construire 2 fonctions VBA Recherche1 et Recherche2 avec 2 Dictionary.

Dans le fichier joint le tableau en Feuil1 est organisé en tableau Excel avec les formules de recherche en colonnes A C D E.

Il n'y a plus de macro dans le code de cette feuille, la mise à jour se fait quand on quitte Feuil2 ou Feuil3.

A+
 

Pièces jointes

Bonjour sircroco, le forum,

Il faut bien comprendre une chose quand comme ici le Dictionary est utilisé dans une fonction.

Il faut impérativement éviter qu'il soit créé pour chaque fonction d'où sa mémorisation dans une variable Public et le test If d Is Nothing.

De ce fait le Dictionary est créé et calculé uniquement lors du 1er calcul de la fonction.

Bonne journée.
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

Retour