Discussion :

[casavba]

Bonjour à tous et à toutes,

Quelqu'un parmi vous, sait comment résoudre le petit problème ci-dessous:

J'ai deux colonnes A et B sur deux feuilles différentes où sont réportoriés des codes clients:

Code :

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

1
2
3
4
5
6
7
8
Colonne A               colonne B
 
V                          X
W                          Z
X                          W
Y                          W
Z                          D
...                        ...

En fait, ce que je cherche à faire, c'est de comparer les codes de la colonne A (il n'y a pas de doublons dans cette colonne) aux codes de la colonne B (il y'a des doublons) et une fois la comparaison est faite, il me copie dans la colonne A tous les codes existants dans la colonne B et ne figurant pas dans la colonne A.

Dans mon exemple, j'aurais ces codes dans la colonne A:

Code :

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

1
2
3
4
5
6
7
8
Colonne A
 
V
W
X
Y
Z
D

le code D figure dans la colonne B et ne figure pas dans la colonne A, donc je dois le copier dans la colonne A et ainsi de suite.

Merci de votre aide.

[patbou]

bonjour,
j ai testé avec 2 feuilles , les codes clients etant sur la colonne 1

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
 
Option Explicit
Option Base 1
Sub comparaison_feuille()
Dim fl1 As Worksheet
Dim fl2 As Worksheet
Dim plage1
Dim plage2
Dim i
Dim j
Dim c
Dim tabl()
Dim rech As Range
Dim lastcell1
Dim lastcell2
Set fl1 = Worksheets(1)
Set fl2 = Worksheets(2)
 
With fl1
   lastcell1 = .Cells(65536, 1).End(xlUp).Row
   plage1 = .Range("a1" & ":a" & lastcell1)
End With
      With fl2
            lastcell2 = .Cells(65536, 1).End(xlUp).Row
            plage2 = .Range("a1" & ":a" & lastcell2)
      End With
 
  For i = 1 To UBound(plage2, 1)
       With fl1.Range("a1" & ":a" & lastcell1)
            Set c = .Find(plage2(i, 1))
                    If c Is Nothing Then
                        j = j + 1
                        ReDim Preserve tabl(j)
                        tabl(j) = plage2(i, 1)
                        Debug.Print tabl(j)
                    End If
      End With
Next i
 
'If tabl() Is Nothing Then Exit Sub 'si la liste est identique
'une erreure est generée
 
For i = 1 To UBound(tabl())
    fl1.Cells(lastcell1 + i, 1).Value = tabl(i)
Next i
 
End Sub

nota : si les 2 listes sont identiques une erreure est generée

[casavba]

Merci, pour la réponse Patbou.
ton code, c'est vrai qu'il copie les codes inexistant dans la colonne A, mais le problème c'est qu'il copie aussi les doublons, or ce que je cherche c de copier sans doublons.

J'essaie d'adapter ton code, je te tiens au courant de l'état d'avancement.

[Invité]

Bonjour Casavba,

Regardez ici (et en particulier le fichier joint par Boisgontier sur sa dernière réponse) :

http://www.developpez.net/forums/sho...=428702&page=2

[casavba]

En fait, Patbou, j'ai bricolé ta solution en ajoutant une Boucle et ça marche

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
 
Option Explicit
Option Base 1
Sub comparaison_feuille()
Dim fl1 As Worksheet
Dim fl2 As Worksheet
Dim plage1
Dim plage2
Dim i
Dim j
Dim c
Dim tabl()
Dim rech As Range
Dim lastcell1
Dim lastcell2
Set fl1 = Worksheets(1)
Set fl2 = Worksheets(2)
 
With fl1
   lastcell1 = .Cells(65536, 1).End(xlUp).Row
   plage1 = .Range("a1" & ":a" & lastcell1)
End With
      With fl2
            lastcell2 = .Cells(65536, 1).End(xlUp).Row
            plage2 = .Range("a1" & ":a" & lastcell2)
      End With
 
  For i = 1 To UBound(plage2, 1)
       With fl1.Range("a1" & ":a" & lastcell1)
            Set c = .Find(plage2(i, 1))
                    If c Is Nothing Then
                        j = j + 1
                        ReDim Preserve tabl(j)
                        tabl(j) = plage2(i, 1)
                        Debug.Print tabl(j)
                    End If
      End With
Next i
 
'If tabl() Is Nothing Then Exit Sub 'si la liste est identique
'une erreure est generée
 
For i = 1 To UBound(tabl())
    fl1.Cells(lastcell1 + i, 1).Value = tabl(i)
Next i
 
With fl1
        lastcell3 = .Cells(65536, 1).End(xlUp).Row
End With
 
For i = lastcell3 To lastcell3 - UBound(tabl()) Step -1
    For j = lastcell3 To i + 1 Step -1
        If fl1.Range("A" & j).Value = fl1.Range("A" & i).Value Then
            fl1.Range("A" & j).Delete
        End If
    Next j
Next i
 
End Sub

Voilà Merci pour l'aide.

Mais ne peut-on pas supprimer les doublons du tableau ("tabl") avant de le copier??

[patbou]

bonsoir,
j ai rajouter une suppression doublon dans le tableau (tabl())

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
 
Option Explicit
Option Base 1
Sub comparaison_feuille()
Dim fl1 As Worksheet
Dim fl2 As Worksheet
Dim plage1, plage2
Dim i, j, k
Dim c
Dim doublon As Boolean
Dim tabl(), tabl_trier()
Dim rech As Range
 
Dim lastcell1
Dim lastcell2
Set fl1 = Worksheets(1)
Set fl2 = Worksheets(2)
 
With fl1
lastcell1 = .Cells(65536, 1).End(xlUp).Row
plage1 = .Range("a1" & ":a" & lastcell1)
End With
With fl2
lastcell2 = .Cells(65536, 1).End(xlUp).Row
plage2 = .Range("a1" & ":a" & lastcell2)
 
End With
 
  For i = 1 To UBound(plage2, 1)
     With fl1.Range("a1" & ":a" & lastcell1)
          Set c = .Find(plage2(i, 1))
                    If c Is Nothing Then
                        j = j + 1
                        ReDim Preserve tabl(j)
                        tabl(j) = plage2(i, 1)
                    End If
    End With
Next i
 
'recherche des doublons dans le tableau
For i = 1 To UBound(tabl()) - 1
    doublon = False
    For j = i + 1 To UBound(tabl())      
        If tabl(i) = tabl(j) Then
          doublon = True
        End If
    Next j
            If doublon = False Then
                 k = k + 1
                 ReDim Preserve tabl_trier(k + 1)
                 tabl_trier(k) = tabl(i)
                 tabl_trier(k + 1) = tabl(UBound(tabl()))        
    End If
Next i
'If tabl() Is Nothing Then Exit Sub 'si la liste est identique
'une erreure est generée
For i = 1 To UBound(tabl_trier())
fl1.Cells(lastcell1 + i, 1).Value = tabl_trier(i)
Next i
End Sub

[casavba]

Thanks Patbou.