Recouper les données entre deux listes

**greg4646** · 14/08/2007, 08h42

Bonjour à tous,
Voila je débute en macro et je dois réaliser un fichier me permettant de connaitre par rapport à une liste les elements commun à une autre liste!
Je m'explique j'ai un classeur, dans se classeur j'ai trois feuilles:
Feuille 1 : "Données GCP"
Feuille 2 : "Données Internet"
Feuille 3 : "Resultat concordance"
Dans la feuille 1 je la colone A B rempli
A : "Nom societe:
B : "Numero siren"
Dans la feuille 2 idem sauf
A : "rang hierarchique"
B : "Nom societe:
C : "Numero siren"
Et dans la feuille 3 j'aimerais avoir la meme presentation que la feuille 2.
Pour cela il faut que je comparer le numero de siren de la feuille 1 avec la feuille 2 et que si il est pareil je copie la ligne de la feuille 2 correspondant dans la feuille trois!

Et la c'est la memerde je n'arrive pas à faire cette macro!
Aidez moi svp!

**ouskel'n'or** · 14/08/2007, 09h45

As-tu essayé d'écrire la procédure en français avant de te lancer dans le code ?
Tu as Feuil1 feuil2 et feuil3
Dans Feuil1, No Siren est dans la colonne B
Dans Feuil2, No Siren est dans la colonne C

Il nous manque des informations.
Je déduis que dans feuil1 les données ne sont pas classées dans le même ordre que dans feuil2... sinon tu n'aurais pas de pb.
Tu dois donc "visiter" feuil1, colonne B, de la première à la dernière ligne.
Pour chaque N° Siren lu, tu dois rechercher dans Feuil2 colonne C l'existence de ce N°. Il existe => Copie de la ligne feuil2, après la dernière ligne renseignée feuil3.
Il te faut donc
- connaître la Plage à comparer dans feuil1 (No dernière ligne)
Set Plage = range("B?:B" & dernièreLigne1)
- connaître la plage de recherche dans feuil2
Range("C1:C" & DernièreLigne2)
- une boucle pour parcourir cette plage feuil1, colonne B
for each cell in Plage
- une instruction de recherche du N° siret feuil2, colonne C
Set c = .find
- connaître le N° de la dernière ligne renseignée dans feuil3

J'ai fait ça mais si tu ne comprends pas, ça ne t'avancera pas pour le futur.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
44
45
46
47
48
Sub ChercheTrouveCopieColle()
Dim F1 As Worksheet
Dim F2 As Worksheet
Dim F3 As Worksheet
Dim Plage1 As Range
Dim Plage2 As Range
Dim derniereLigne1 As Long, derniereLigne2 As Long, derniereLigne3 As Long
Dim NoSiren
 
    'Instanciation des trois feuilles de calculs
    Set F1 = Worksheets("Feuil1")
    Set F2 = Worksheets("Feuil2")
    Set F3 = Worksheets("Feuil3")
 
    'Recherche de la dernièreligne des 2 premières feuilles
    derniereLigne1 = F1.Range("B65535").End(xlUp).Row
    derniereLigne2 = F2.Range("C65535").End(xlUp).Row
 
    'Recherche de la première ligne vide dans feuil3
    derniereLigne3 = F3.Range("C65535").End(xlUp).Row + 1
 
    'Instanciation des plages de lecture feuil1 et de recherche, feuil2
    Set Plage1 = F1.Range("B2:B" & derniereLigne1)
    Set Plage2 = F2.Range("C2:C" & derniereLigne2)
 
    'Parcours de la colonne B feuil1
    For Each cell In Plage1
        NoSiren = cell 'lecture du N° siren
 
        'recherche de ce N° dans feuil2
        With Plage2
            Set c = .Find(NoSiren, LookIn:=xlValues)
            If Not c Is Nothing Then
                c.EntireRow.Copy destination:=F3.Cells(derniereLigne3, 1)
            End If
        End With
 
        'On a collé une ligne, la première ligne vide change, on la recherche
        derniereLigne3 = F3.Range("C65535").End(xlUp).Row + 1
    Next
 
    'Init des instances
    Set F1 = Nothing
    Set F2 = Nothing
    Set F3 = Nothing
    Set Plage1 = Nothing
    Set Plage2 = Nothing
End Sub

Pas resté, tu peux faire ça pour nous en changeant les noms de feuilles ?

**greg4646** · 14/08/2007, 10h09

Je n'ai pas changer l'étendus des lignes dans les colones car celle-ci sont variable!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
44
45
46
47
48
Sub ChercheTrouveCopieColle()
Dim F1 As Worksheet
Dim F2 As Worksheet
Dim F3 As Worksheet
Dim Plage1 As Range
Dim Plage2 As Range
Dim derniereLigne1 As Long, derniereLigne2 As Long, derniereLigne3 As Long
Dim NoSiren
 
    'Instanciation des trois feuilles de calculs
    Set F1 = Worksheets("Données Base GCP ")
    Set F2 = Worksheets("Données Base Internet")
    Set F3 = Worksheets("Resultat concordance")
 
    'Recherche de la dernièreligne des 2 premières feuilles
    derniereLigne1 = F1.Range("B65535").End(xlUp).Row
    derniereLigne2 = F2.Range("C65535").End(xlUp).Row
 
    'Recherche de la première ligne vide dans feuil3
    derniereLigne3 = F3.Range("C65535").End(xlUp).Row + 1
 
    'Instanciation des plages de lecture feuil1 et de recherche, feuil2
    Set Plage1 = F1.Range("B2:B" & derniereLigne1)
    Set Plage2 = F2.Range("C2:C" & derniereLigne2)
 
    'Parcours de la colonne B feuil1
    For Each cell In Plage1
        NoSiren = cell 'lecture du N° siren
 
        'recherche de ce N° dans feuil2
        With Plage2
            Set c = .Find(NoSiren, LookIn:=xlValues)
            If Not c Is Nothing Then
                c.EntireRow.Copy Destination:=F3.Cells(derniereLigne3, 1)
            End If
        End With
 
        'On a collé une ligne, la première ligne vide change, on la recherche
        derniereLigne3 = F3.Range("C65535").End(xlUp).Row + 1
    Next
 
    'Init des instances
    Set F1 = Nothing
    Set F2 = Nothing
    Set F3 = Nothing
    Set Plage1 = Nothing
    Set Plage2 = Nothing
End Sub

**greg4646** · 14/08/2007, 10h21

Excusez moi je n'avait pas tout compris donc rectification j'ai garder le code de: Ouskel'n'or et j'ai changer dans mon classeur les feuilles!!!
apres l'execution de la macro je peux dire BRAVO c'est ce que je doit optenir le resultat est bon il me signal juste une ligne dans le code qui ne convient pas je pense que c'est due au critere d'arret!!

comment dire de stopper le déroulemùent du programme quand il n'y a plus de données dans la feuil 2

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
 'recherche de ce N° dans feuil2
        With Plage2
            Set c = .Find(NoSiren, LookIn:=xlValues)
            If Not c Is Nothing Then
                c.EntireRow.Copy Destination:=F3.Cells(derniereLigne3, 1)
            End If
        End With

**ouskel'n'or** · 14/08/2007, 12h02

Pour le nom des feuilles, ton code me paraissait bon, sauf l'espace à la fin du nom de la feuille 1. Tu es sûr que tu as un espace ?

Pour ton dernier message, tu vas devoir modifier la procédure, mais précise le phénomène, je ne suis pas sûr de comprendre.

**greg4646** · 14/08/2007, 13h18

J'ai essayer de voir si il y avait des problemes pendant un teste et c'est tout bon plus aucun beug le code est correct!
j'ai corriger egalement l'espace de feuil1.

Je te remercie vivement tu m'as fais gagner un temps pressieux.

**greg4646** · 14/08/2007, 15h13

Je me permet de vous demamndez un dernier coup de main.
Pouvez vous me dire comment tronquer les 5 dernier numero de chaques cellules dans toute une colone?
J'ai une feuil qui se nome fournisseur et j'ai dans la colone B des cellule vide, =0, et de chiffres j'aimerai pouvoir tronquer les 5 dernier numero en partant de la fin

toujour en macro si c'est plus simple

Encore mercie et Bravo

**ouskel'n'or** · 15/08/2007, 10h27

Je reprends F1 et plage comme instances de feuille et de plage

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
For each cell in Plage
    if not cell = 0 and not Cell = "" then
         If len(cell) > 5 then
              Cell.value = Left(cell, len(cell)-5)
         endif
    endif
Next

... si c'est bien là ce que tu veux faire

Recouper les données entre deux listes

Macros et VBA Excel

Discussions similaires

Partager

Partager