Discussion :

[debutanteVba]

Bonjour

je dispose de 2 tableau

le 1 er contient 3000ligne et 5 colonnes( seule la 1ere et 5 colonnes me seront utiles)

le 2eme contient 10000 lignes et 2 colonnes


je souhaite comparer la 1ere colonne des 2tableaux , si le code est le meme dans ce cas la je veux copier la valeur de la colonne 2 du 2eme tableau dans la colonne 5 du 1er tableau


merci bcp pour votre aide

[Kimy_Ire]

Salut debutanteVba,

En 1) le mot "URGENT" ne sert à rien. Je dirais même qu'il rebute...

Ensuite, on est bien avancé avec ce que tu nous donnes. ^^
Tes tableaux sont sur la même feuille ? Dans le même classeur ?

Pourquoi utiliser le VBA ?
Pourquoi ne pas faire simplement une rechercheV ?

J'attends ton retour.

Cordialement,
Kimy

[debutanteVba]

Bonjour

loin de moi l'idée de déranger qui que ce soit avec mon Urgent, je l'ai mis parce que ca me bloque de mon côté c'est tout !

Mes deux tableaux sont dans la même feuille

j'ai opté pour VBA parce que je pense que ca me donnera un resultat rapidement et sans faire aucune modification sur ma feuille

en effet, j'ai des codes qui existent dans un tableau et pas dans l'autre

mais si vous avez une formule avec rechercheV je suis prenante

merci

cdt

[Toine-45]

Bonjour
Avec ça, tu devrais t'en sortir

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
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
 
Sub A_inventaire_par_Boites_Dialogue_Test()
 
'Définition =======================
Dim nfref As String 'déclare la variable nfref (Nom du Fichier de REFérence)
Dim fref As Workbook 'déclare la variable fref (Fichier de REFérence)
Dim nfrech As String 'déclare la variable nfrech (Nom Fichier RECHerche)
Dim frech As Workbook 'déclare la variable frech (Fichier de RECHerche)
Dim noref As String 'déclare la variable noref (Nom Onglet de REFérence)
Dim oref As Object 'déclare la variable oref (Onglet de REFérence)
Dim norech As String 'déclare la variable norech (Nom Onglet de RECHerche)
Dim orech As Object 'déclare la variable orech (Onglet de RECHerche)
Dim colref As String 'déclare la variable colref (COLonne de REFérence)
Dim dlref As Integer 'déclare la variable dlref (Dernière Ligne de REFérence)
Dim colrech As String  'déclare la variable colrech (Colonne de RECHerche)
Dim dlrech As Integer 'déclare la variable dlrech (Dernière Ligne RECHerche)
Dim plref As Range 'déclare la variable plref (PLage de REFérence)
Dim plrech As Range 'déclare la variable plrech (PLage de RECHerche)
Dim cac As String 'déclare la variable cac (Colonne A Copier)
Dim cdst As String 'déclare la variable cdst (Colonne de DeSTination)
Dim r As Range 'déclare la variable r (Recherche)
Dim Cel As Range 'déclare la variable cel (CELlule)
Dim pa As String 'déclare la variable pa (Première Adresse)
 
'Attribution des variables ==============================
On Error GoTo ErreurFichier 'Si erreur de nom de classeur ou feuille : activation message d'erreur
nfref = InputBox("Nom du fichier de référence", "Référence") 'définit la variable nfref
If nfref = "" Then Exit Sub 'si boîte d'entrée non renseignée ou bouton "Annuler", sort de la procédure
Set fref = Workbooks(nfref & ".xls") 'définit le classeur fref
nfrech = InputBox("Nom du fichier de Recherche", "Recherche") 'définit la variable nfrech
If nfrech = "" Then Exit Sub 'si boîte d'entrée non renseignée ou bouton "Annuler", sort de la procédure
Set frech = Workbooks(nfrech & ".xls") 'définit le classeur frech
noref = InputBox("Nom de l'onglet de référence", "Référence") 'définit la variable noref
If noref = "" Then Exit Sub 'si boîte d'entrée non renseignée ou bouton "Annuler", sort de la procédure
Set oref = fref.Sheets(noref) 'définit l'onglet source oref du classeur source
norech = InputBox("Nom de l'onglet de recherche", "Recherche") 'définit la variable norech
If norech = "" Then Exit Sub 'si boîte d'entrée non renseignée ou bouton "Annuler", sort de la procédure
Set orech = frech.Sheets(norech) 'définit l'onglet orech du classeur cible
On Error GoTo 0 'annule la gestion des erreurs
colref = InputBox("Colonne de référence", "Référence") 'définit la variable colref
If colref = "" Then Exit Sub 'si boîte d'entrée non renseignée ou bouton "Annuler", sort de la procédure
dlref = oref.Cells(Application.Rows.Count, colref).End(xlUp).Row 'définit la dernière ligne éditée dlref de la colonne de référence colref
colrech = InputBox("Colonne de recherche", "Recherche")
If colrech = "" Then Exit Sub 'si boîte d'entrée non renseignée ou bouton "Annuler", sort de la procédure
dlrech = orech.Cells(Application.Rows.Count, colrech).End(xlUp).Row 'définit la dernière ligne éditée dlrech de la colonne de recherche colrech
Set plref = oref.Range(colref & "2:" & colref & dlref) 'définit la plage  de référence plref
Set plrech = orech.Range(colrech & "2:" & colrech & dlrech) 'définit la plage  de recherche plrech
cac = InputBox("Colonne de la cellule à copier", "Copier") 'définit la variable cac
cdst = InputBox("Colonne de destination", "Coller") 'définit la variable cdst
 
'Traitement =======================
For Each Cel In plref 'boucle sur toutes les cellules cel de la plage plref
    If Cel.Value <> "" Then 'condition 1 : si Cel n'est pas vide
        Set r = orech.Columns(colrech).Find(Cel.Value, , xlValues, xlWhole) 'définit la recherche r
        If Not r Is Nothing Then 'condition 2 : si il existe au moins une occurrence trouvée
            pa = r.Address 'définit l'adresse pa de la première occurrence trouvée
            Do 'exécute
            orech.Cells(r.Row, cac).Copy oref.Cells(Cel.Row, cdst)
            Set r = orech.Columns(colrech).FindNext(r) 'redéfinit la recherche r (occurrence suivante)
            Loop While Not r Is Nothing And r.Address <> pa 'boucle tant qu'il existe des occurrences ailleurs au'en pa
        End If 'fin de la condition 2
    End If 'fin de la condition 1
Next Cel    'Boucle sur cellule suivante
Exit Sub
ErreurFichier:
MsgBox "!Erreur de nom de classeur ou de feuille !"
End Sub

Bonne soirée

Cordialement

[Kimy_Ire]

Je te propose ceci :

1) Définir la plage de ton premier tableau
Sélectionner ton tableau 1 en entier.
Onglet "Formule" > "Gestionnaire de noms" (sous 2007 - désolé je n'ai pas 2010 ) > Nouveau
Insérer le nom souhaité : "Ma_plage".

2) La formule
Sur la colonne 2 de ton tableau 2 :

Code :

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

=RECHERCHEV(G1; Ma_plage; 5; FAUX)

=> G1 est l'emplacement de ton premier code de ton tableau 2

Puis double-cliques sur le petit carré en bas à droite de la cellule.

Tiens moi au courant !

Cordialement,
Kimy

[nibledispo]

Bonjour debutanteVBA,

le code ci-dessous cogité par Philippe TULLIEZ permet de comparer la colonne A de deux feuilles 1 et 2 et renvoie les cellules identiques en colonne A d'une feuille 3.

si le nombre de cellules renvoyé sur la feuille 3 est identique aux deux autres feuilles, c'est que tes deux colonnes sont identiques en contenu.

il te suffit d'adapter si tes colonnes à comparer sont sur la même feuille.

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
 
 
Sub Extraction_Exemple1() 'Philippe thulliez
 
Feuil3.[a1:a20].ClearContents 'effacement de la feuille feuil3 comportant les résultats
 
 ' Déclaration / Affectation
 Dim rng_1 As Range, rng_2 As Range, rng_Export As Range
 Dim r As Long, Depl As Long, Pos As Long
 With ThisWorkbook
  Set rng_1 = .Worksheets("Feuil1").Range("A1").CurrentRegion
  Set rng_2 = .Worksheets("Feuil2").Range("A1").CurrentRegion
  Set rng_Export = .Worksheets("Feuil3").Range("A1")
 End With
 ' Boucle sur la feuille 1
 For r = 2 To rng_1.Rows.Count
  On Error Resume Next
  Pos = Application.Match(rng_1.Cells(r, 1), rng_2.Resize(, 1), 0)
  If Err = 0 Then
   MsgBox Depl
   Depl = Depl + 1
   MsgBox Depl
   With rng_1
   .Range(.Cells(r, 1), .Cells(r, .Columns.Count)).Copy rng_Export.Offset(Depl, 0)
   End With
  End If
  On Error GoTo 0
 Next r
 
Feuil3.Select
End Sub

Cordialement

[Marc-L]

Bonjour,

j'ai peut être plus rapide et puissant mais afin d'être sûr de son adéquation,
une présentation claire & exhaustive du besoin est vraiment nécessaire !

[debutanteVba]

je vous remercie pour votre aide, mon problème est résolu

cordialement