Macro Recherche avec 2 variables

Version imprimable

Bonjour à tous,
Malgré de très longues heures de recherche et n’étant pas parvenu à mes fins, je m’en remets votre aide, je suis désespéré! :d
Je travaille pour le boulot sur une macro qui aurait plusieurs utilités.
L’une d’entre-elles serait la suivante :

Dans une feuille donnée (« feuillesource ») on trouve:
En A 1, A2, A3 (liste verticale) , les différentes valeurs (nomdefeuille) représentant le nom de la feuille du classeur sur laquelle rechercher à chaque fois une seconde valeur (valeur2).
A1 = Feuil1 , A2 = Feuil2, etc…

Une fois cette variable(nomdefeuille) définie, il faudra définir une seconde variable à partir de l'emplacement de la première:
C'est à dire: La valeur de la 1ère cellule à droite de la (nomdefeuille), cette 2nde variable s’appellera (valeur2).

Deuxième étape :
Se rendre sur (Feuil1) et y chercher (valeur2).
Une fois (valeur2) trouvée, copier le contenu des 30 cellules qui sont en dessous et les coller sur une autre feuille quelconque.

3ème étape :
Une fois la 2ème étape effectuée, la macro devrait retourner sur (« feuillesource ») et y chercher la valeur se trouvant cette fois-ci DEUX cellules à droite de Cells(« nomdefeuille ») .
Une fois trouvée, la valeur de cette cellule deviendra la nouvelle (valeur2) à chercher et trouver sur (« Feuil1 »), toujours, pour ensuite répéter l'opération de copier/coller .

Lorsqu’il n’y aura plus de valeur à droite de Cells(« nomdefeuille »), la macro devra aller chercher la nouvelle variable (nomdefeuille) en descendant d’une ligne, en l’occurrence pour trouver (nomdefeuille) = Feuil2, en A2

Je suis désolé de devoir vous expliquer tout cela avec du texte, mais ne maitrisant pas du tout la gestion de variables à définir et surtout leur syntaxe, le code que j’ai grifonné n’aura pas grand sens à vos yeux je pense.
Je vous en colle malgré tout un petit bout (qui n’est qu’une ébauche et contiendra donc des erreurs):
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 Sub test3() Dim lignenomfeuille As String Dim nompartner As String Dim cellulepartner As Range Dim ligne As Integer Dim col As Integer lignenomfeuille = 1 cellulepartner = 2 'définit début recherche partner If Sheets("feuillesource").Cells("cellulepartner,1") <> 0 Then nompartner = Sheets("Clicks").Cells("cellulepartner,1").Value 'va à la feuille concernée Sheets("feuille").Activate 'cherche le partner dans la feuille Set cellulepartner = Range("A1:E5").Find(nompartner, lookat:=xlWhole) End Sub
Je remercie d'avance les bonnes âmes qui voudront bien m'aider...
Si vous avez besoin de précisions n'hésitez pas :)

Merci
Maxime

bonjour,
vous le constaterez,les développeurs sont friand de détails,cela permet d'avoir une vision clair de votre problème et d'apporter la solution la plus appropriée.je vous conseillerez donc d'être plus précis et de ne pas aller trop vite concernant les étapes,cherchez à les résoudre une par une.concernant votre étape 2 vous demander la recherche d'une valeur dans une feuille,c'est un peu vague,ou chercher cette valeur2?(ligne?,colonne?) aussi les valeurs sont de quel type?quel version d'excel utilisez vous?votre liste verticale continet combien d'éléments?ce sont autant de détails qui peuvent faire la différence.je vous propose un bout de code qui devrait permettre de passer l'étape1 en attendant un meilleur éclaircissement pour passer à l'étape 2
Code:

1 2 3 4 5 6 7 8 9 10 11 12 sub test1 dim a as string dim b as integer,i as integer for i=1 to 100 'je ne connais pas le nombre d'élémentde ta liste verticale donc je me fixe arbitrairement 100 a=worksheets("nomdelafeuilleactive").cells(i,1) 'a récupère le nom de la feuille b=worksheets("nomdelafeuilleactive").cells(i,2) 'b récupère la valeur 2 thisworkbook.sheets("a").activate 'se rendre sur une feuille end sub
Cordialement

1 pièce(s) jointe(s)

Bonjour,

Voici un code pour commencer.
Regarde si cela correspond à ton attente et n’hésite pas à poser des questions si besoin.
Je joints le fichier test pour te permettre de faire les comparaisons de structure avec ton fichier.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Sub Recherche()
Dim DerLig As Long
Dim DerCol As Integer
Dim WsCible As Worksheet
Dim WsSource As Worksheet
Dim MaPlage As Range, Cel As Range
    Set WsCible = Worksheets("Synthese")
    WsCible.Cells.Delete
    With Worksheets("feuillesource")
        DerLig = .Range("A" & .Rows.Count).End(xlUp).Row
        Set MaPlage = .Range("A2:A" & DerLig)
        For Each Cel In MaPlage
            i = 0
            While Cel.Offset(0, i) <> ""
                i = i + 1
                Set WsSource = Worksheets(Cel.Value)
                Set Valeur = WsSource.Cells.Find(Cel.Offset(0, i))
                If Not Valeur Is Nothing Then
                    DerCol = WsCible.Cells(1, WsCible.Columns.Count).End(xlToLeft).Column
                    If WsCible.Range("A1") = "" And DerCol = 1 Then DerCol = 0
                    Valeur.Offset(1, 0).Resize(30, 1).Copy Destination:=WsCible.Cells(1, DerCol + 1)
                End If
                Set WsSource = Nothing
                Set Valeur = Nothing
            Wend
        Next Cel
    End With
    WsCible.Activate
    Set MaPlage = Nothing
    Set WsCible = Nothing
End Sub

Cordialement.

13/03/2012, 21h51
LeSmoox

1 pièce(s) jointe(s)

Bonsoir,

Tout d'abord merci à vous deux!
Je sais que l'énoncé du problème faisait tout sauf donner envie de le résoudre :D

Pour ce qui est des détails :
Support : Excel 2003 (Excel 2010 mais fichier enregistré comme 97-03)
Valeur2 : A chercher dans la la ligne 2 (par exemple) de la feuille définie par la première variable (nomfeuille).

gFZT82, merci pour votre code, mais je l'ai essayé en y apportant quelques modifications (nom des feuilles etc) et le résultat n'était pas celui escompté. Le problème du code que vous m'avez fourni est que je n'arrive pas à comprendre certaines lignes, même en le prenant pas à pas (notamment celles renvoyant à la "dernière ligne"), ce qui fait que je n'arrive pas à réutiliser ces lignes dans un code que j'écrirais moi même.

Je vous joint mon fichier test qui est globalement similaire au fichier original car la macro étant pour le boulot, je ne peux pas vous envoyer l'original :-S

Donc, en utilisant le fichier test et pour résumer :

Je souhaite que dans la feuille "Clicks", la macro cherche la valeur dans A1 et s'en serve comme première variable (nomfeuille).
Dans un 2ème temps, se rendre sur la cellule à droite de A1 et considérer la valeur comme une deuxième variable (nompartner).

Ensuite, se rendre sur la feuille(nomfeuille) donc (Foglio1) en l'occurrence et chercher dans la ligne 2 : (nompartner).
Une fois trouvée la cellule, copier les 10 lignes qui se trouvent en dessous et les coller dans endroit que je déterminerai plus tard.

IMPORTANT :
Lorsque les données (nompartner) auront été collées, il faut retourner sur "Clicks", se décaler d'une cellule encore sur la droite et prendre sa valeur pour la définir comme nouveau (nompartner), et recommencer l'opération de copiage.
Lorsqu'il n'y a plus de (nompartner) à prendre, il faut descendre d'une ligne (donc en B2) et considérer B2.Valuer comme nouveau (nomfeuille) et recommencer l'opération de recherche de partner/copier-coller etc...

La procédure devrait se terminer lorsque la liste de (nomfeuille) est terminée :D

Dans le fichier joint ne faîtes pas attention aux macros présentes dans l'éditeur, ce sont des brouillons d'amateur...

De mon côté je me remets à chercher du code via les tutoriels, si j'avance je vous tiens au courant.

Un grand merci à vous

Maxime

1 pièce(s) jointe(s)

Dans la feuille « Foglio1 » on voit apparaitre 2 fois le Part A (idem pour Part B).
L’opération est à répéter pour tous les Part A (ou Part B) ?

Re,

J’ai supposé que l’opération est à réaliser autant de fois que le partner est noté dans la feuille Foglio(x).
Dans Foglio1, le Part A est noté 2 fois ; il y aura donc 2 copies.
Idem pour Part B.
Pour pouvoir tester le code, j’ai créé une deuxième feuille (Foglio2) ainsi qu’une feuille de synthèse pour coller les lignes copiées.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
Sub Recherche()
Dim DerLig As Long 'Dernière ligne renseignée de la feuille "Clicks"
Dim DerCol As Integer 'Dernière colonne renseignée de la feuille cible (feuille "Synthese")
Dim WsCible As Worksheet 'La feuille cible est celle ou sont collées les données (feuille "Synthese")
Dim WsSource As Worksheet 'La feuille source est celle ou sont copiées les données (feuille "Foglio1")
Dim MaPlage As Range, Cel As Range
    Set WsCible = Worksheets("Synthese")
    With Worksheets("Clicks")
        'Recherche de la dernière ligne renseignée dans colonne A
        DerLig = .Range("A" & .Rows.Count).End(xlUp).Row
        'Definition Plage de A1 à A" & Derlig
        Set MaPlage = .Range("A1:A" & DerLig)
        'On passe sur chaque cellule de la colonne A afin d'avoir le nom de la feuille à examiner
        For Each Cel In MaPlage
            i = 0
            'Tant que la cellule à droite du nom de feuille n'est pas vide
            While Cel.Offset(0, i + 1) <> ""
                i = i + 1
                'On déclare la feuille à examiner
                Set WsSource = Worksheets(Cel.Value)
                'On recherche la cellule correspondant au partner associé
                Set valeur = WsSource.Rows(2).Find(What:=Cel.Offset(0, i), After:=WsSource.Cells(2, WsSource.Columns.Count), LookIn:=xlValues, _
                LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext)
                If Not valeur Is Nothing Then
                    firstAddress = valeur.Address
                    Do
                        'On recherche la dernière colonne renseignée de la feuille cible
                        DerCol = WsCible.Cells(1, WsCible.Columns.Count).End(xlToLeft).Column
                        If WsCible.Range("A1") = "" And DerCol = 1 Then DerCol = 0
                        'On copie les 10 cellules en dessous de la cellule trouvée et on les colle dans la feuille cible
                        valeur.Offset(1, 0).Resize(10, 1).Copy Destination:=WsCible.Cells(1, DerCol + 1)
                        Set valeur = WsSource.Rows(2).FindNext(valeur)
                    Loop While Not valeur Is Nothing And valeur.Address <> firstAddress
                End If
                Set WsSource = Nothing
                Set valeur = Nothing
            Wend
        Next Cel
    End With
    WsCible.Activate
    Set MaPlage = Nothing
    Set WsCible = Nothing
End Sub

Cordialement.

gFZT82 je ne sais comment te remercier d'avoir pris le temps de m'aider!

Le code marche parfaitement.
Je cherche encore à comprendre en profondeur les lignes qui suivent, car bien que je puisse avancer grâce au fichier et que j'ai compris le concept de chaque ligne, certains petits détails sont malgré tout difficiles à intégrer.
J'aimerais assimiler les subtilités afin de pouvoir me débrouiller plus facilement la prochaine fois.
Une autre chose, la macro n'est pour moi pas finie puisque ce n'était qu'une étape du travail, je vais donc y travailler et reviendrai éventuellement vers toi si je bloque de nouveaux, en espèrant que tout aille bien :
En tout cas, merci énormément!!!

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
While Cel.Offset(0, i + 1) <> ""
                i = i + 1
                'On déclare la feuille à examiner
                Set WsSource = Worksheets(Cel.Value)
                'On recherche la cellule correspondant au partner associé
                Set valeur = WsSource.Rows(2).Find(What:=Cel.Offset(0, i), After:=WsSource.Cells(2, WsSource.Columns.Count), LookIn:=xlValues, _
                LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext)
                If Not valeur Is Nothing Then
                    firstAddress = valeur.Address
                    Do
                        'On recherche la dernière colonne renseignée de la feuille cible
                        DerCol = WsCible.Cells(1, WsCible.Columns.Count).End(xlToLeft).Column
                        If WsCible.Range("A1") = "" And DerCol = 1 Then DerCol = 0
                        'On copie les 10 cellules en dessous de la cellule trouvée et on les colle dans la feuille cible
                        valeur.Resize(11, 1).Copy Destination:=WsCible.Cells(1, DerCol + 1)
                        Set valeur = WsSource.Rows(2).FindNext(valeur)
                    Loop While Not valeur Is Nothing And valeur.Address <> firstAddress