Rechercher une valeur dans plusieurs feuilles

  • Initiateur de la discussion Initiateur de la discussion atouil
  • 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 !

atouil

XLDnaute Nouveau
Bonjour,
j'ai un classeur composé de plusieurs feuilles qui contiennent des valeurs associées à des vendeurs sachant que chaque onglet dispose de ses propres vendeurs qui ne figurent pas dans une autre feuille, et j'ai un onglet "Synthèse" avec le nom de tous les vendeurs dans lequel je veux faire apparaitre le prix de vente de chacun d'entre eux.
j'ai essayé plusieurs formules de recherche mais je n'y arrive pas, quelqu'un pourra m'aider svp?

NB: un exemple en PJ

Merci à vous
 

Pièces jointes

Bonjour le fil, bonjour le forum,

Si une proposition VBA intéresse quelqu'un, le code :

VB:
Sub Macro1()
Dim S As Worksheet 'déclare la variable S (onglet Synthèse)
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)

Set S = Worksheets("Synthèse") 'définit l'onglet S
S.Range("A1").CurrentRegion.Offset(1, 0).ClearContents 'efface les anciennes données de l'onglet S
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For Each O In Sheets 'boucle 1 : sur tous les onglets O du classeur
    If O.Name <> "Synthèse" Then 'condition : si l'onglet de la boucle n'est pas l'onglet "Synthèse"
        TV = O.Range("A1").CurrentRegion 'définit le taleau des valeurs TV
        For I = 2 To UBound(TV, 1) 'boucle 2 : sur toutes les lignes I du tableau des valeur TV (en partant de la seconde)
            D(TV(I, 2)) = "" 'alimente le dictionnaore D avec les données de la colonne 2 de TV (le nom)
        Next I 'prochaine ligne de la boucle 2
    End If 'fin de la condition
Next O 'prochain onglet de la boucle 1
TMP = D.Keys 'récupère dans le tableau temporaire TMP la liste des éléments du dictionnaire D sans doublon
For J = 0 To UBound(TMP) 'boucle 1 : sur tous les élément J du tableau temporaire TMP
    For Each O In Sheets 'boucle 2 : sur tous les onglets O du classeur
        If O.Name <> "Synthèse" Then 'condition 1 : si l'onglet de la boucle n'est pas l'onglet "Synthèse"
            TV = O.Range("A1").CurrentRegion 'définit le taleau des valeurs TV
            For I = 2 To UBound(TV, 1) 'boucle 3 : sur toutes les lignes I du tableau des valeur TV (en partant de la seconde)
                If TMP(J) = TV(I, 2) Then 'condition 2 : si l'élément J de la boucle 1 est égal à la donnée ligne I colonne 2 de la boucle 3
                    K = K + 1 'icrémente K
                    ReDim Preserve TL(1 To 2, 1 To K) 'redimensionne le tableau des lignes TL (2 lignes, K colonnes)
                    TL(1, K) = TV(I, 2) 'récupère dans la ligne 1 de TL la donnée en colonne 2 de TV (=> Transposition)
                    TL(2, K) = CLng(TL(2, K)) + CLng(TV(I, 3)) 'récupère dans la ligne 2 de TL sa propre valeur plus la donnée en colonne 3 de TV (=> Transposition)
                End If 'fin de la condition 2
            Next I 'prochaine ligne de la boucle 3
        End If 'fin de la condition 1
    Next O 'prochain onglet de la boucle 2
Next J 'prochain élément de la boucle 1
'si K est supérieure à zéro, renvoie le tableau TL transposé dans la cellule A2 redimensionnée de l'onglet S
If K > 0 Then S.Range("A2").Resize(K, 2).Value = Application.Transpose(TL)
S.Columns(2).NumberFormat = "$#,##0_);[Red]($#,##0)" 'mise au format de la colonne 2
End Sub

Le fichier :
 

Pièces jointes

- 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

Discussions similaires

Retour