Discussion :

[lysander31]

bonjour,
je suis en possession de deux tableaux. je souhaite comparer des colonnes qui contiennent des codes a 10 chiffres ou du vide. Le but est de conserver la ligne si le code du tableau 1 est aussi dans le tableau 2 sinon je supprime la ligne.
j'ai fait ça :

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
 
Sub appel1()
Dim x As Long
Dim u As Long
Dim y As String
Application.ScreenUpdating = False
 
y = ""
For x = 1000 To 5 Step -1
    If (Cells(x, 3) = Valeur) Then
    Range("A" & x & ":E" & x).Delete Shift:=xlUp
    End If
Next x
For x = 1000 To 5 Step -1
    For u = 5 To 1000
        If ((Cells(x, 3)) <> (Cells(u, 10))) And (Trim(Cells(x, 3)) <> "") Then
        Range("A" & x & ":E" & x).Delete Shift:=xlUp
        End If
    Next u
Next x
Range("A5:E1000").Select
Selection.Copy
Range("R5:V1000").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Application.ScreenUpdating = True
Range("A1").Select
End Sub

mais la ça me supprime tout ... pourtant si j'inverse le <> (dans le if) en = il me conserve bien que les codes qui ne sont pas dans les deux tableaux. je comprend pas pourquoi l'inverse ne marche pas ...

merci de votre reponse

[casefayere]

Bonjour,
essayes ce code sur un classeur bidon, si ça te plait, adaptes à ton classeur

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
Sub appel1()
Dim x As Long, Tb1, Tb2, Tbtemp(), TbResult(), DerLg As Range
Dim u As Long
Dim y As Long
'j'imagine un tableau en Feuil1 (A à E)
'un tableau en Feuil2 (A à E)
'le resultat en Feuil3 (A à E)
'les valeurs à comparer en A
With Sheets("Feuil1")
  Set DerLg = .Range("A" & .Rows.Count).End(xlUp)
  Tb1 = .Range("A2", DerLg(1, 5)) 'si lignes de titre en ligne 1
End With
With Sheets("Feuil2")
  Set DerLg = .Range("A" & .Rows.Count).End(xlUp)
  Tb2 = .Range("A2", DerLg(1, 5)) 'si lignes de titre en ligne 1
End With
u = 0
For x = 1 To UBound(Tb1, 1)
  For y = 1 To UBound(Tb2, 1)
    If Tb1(x, 1) = Tb2(y, 1) Then
      u = u + 1
      ReDim Preserve Tbtemp(1 To u)
      Tbtemp(u) = Tb1(x, 1) & ";" & Tb1(x, 2) & ";" & Tb1(x, 3) & ";" & Tb1(x, 4) & ";" & Tb1(x, 5)
    End If
  Next y
Next x
ReDim TbResult(1 To UBound(Tbtemp), 1 To 5)
 
For x = 1 To UBound(Tbtemp)
  For y = 1 To 5
    TbResult(x, y) = Split(Tbtemp(x), ";")(y - 1)
  Next y
Next x
With Sheets("Feuil3")
  Set DerLg = .Range("E" & .Rows.Count).End(xlUp)
  If DerLg.Row > 1 Then .Range("A2", DerLg).ClearContents
  .Range("A2").Resize(UBound(TbResult, 1), 5) = TbResult
End With
Erase Tbtemp
End Sub

[lysander31]

salut casefayere
merci pour ta réponse ça marche nickel par contre je comprend pas comment tu choisis les cellules que l'on copie ? dans un cas je voudrai copier la valeur de la cellule testé et dans l'autre la valeur d'une cellule de la ligne

[casefayere]

Je ne comprends pas ce que tu demandes, d'apràs ton 1er post

Le but est de conserver la ligne si le code du tableau 1 est aussi dans le tableau 2 sinon je supprime la ligne.

et maintenant tu dis

dans un cas je voudrai copier la valeur de la cellule testé et dans l'autre la valeur d'une cellule de la ligne

[lysander31]

Désolé je me suis mal exprimé. Je voulais savoir si au lieu de garder toute la ligne il était possible d'en garder une partie.
Par exemple le code est dans les deux tableau et au lieu de garder les cellules de A à E on garde seulement la cellule A ou B mais quand on supprime au supprime l'intégralité de la ligne

[casefayere]

Bonjour,

A partir de ce que tu écris :

Par exemple le code est dans les deux tableau et au lieu de garder les cellules de A à E on garde seulement la cellule A ou B mais quand on supprime au supprime l'intégralité de la ligne

Il suffit, en gardant mon exemple de changer ces lignes

Code :

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

1
2
3
4
...      ReDim Preserve Tbtemp(1 To u)
      Tbtemp(u) = Tb1(x, 1) & ";" & Tb1(x, 2) & ";" & Tb1(x, 3) & ";" & Tb1(x, 4) & ";" & Tb1(x, 5)
    End If
..

en, pour garder A et B

Code :

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

1
2
3
4
...      ReDim Preserve Tbtemp(1 To u)
      Tbtemp(u) = Tb1(x, 1) & ";" & Tb1(x, 2) 
    End If
...

et plus bas :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
ReDim TbResult(1 To UBound(Tbtemp), 1 To 2)
 
For x = 1 To UBound(Tbtemp)
  For y = 1 To 2
    TbResult(x, y) = Split(Tbtemp(x), ";")(y - 1)
  Next y
Next x
With Sheets("Feuil3")
  Set DerLg = .Range("B" & .Rows.Count).End(xlUp)
  If DerLg.Row > 1 Then .Range("A2", DerLg).ClearContents
  .Range("A2").Resize(UBound(TbResult, 1), 2) = TbResult
End With
Erase Tbtemp
End Sub

J'espère que tu comprendras mieux les changements

[casefayere]

Pour comprendre la démarche, je te propose une autre procédure (à des fins d'initiation)

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
Sub appel1()
Dim x As Long, Tb1, Tb2, Tbtemp(), TbResult(), DerLg As Range
Dim u As Long, CelGardee As Integer
Dim y As Long, DerCol As Range
'j'imagine un tableau en Feuil1 (A à E)
'un tableau en Feuil2 (A à E)
'le resultat en Feuil3 (A à E)
'les valeurs à comparer en A
CelGardee = InputBox("combien de colonnes à garder")
With Sheets("Feuil1")
  Set DerLg = .Range("A" & .Rows.Count).End(xlUp)
  Tb1 = .Range("A2", DerLg(1, 5)) 'si lignes de titre en ligne 1
End With
With Sheets("Feuil2")
  Set DerLg = .Range("A" & .Rows.Count).End(xlUp)
  Tb2 = .Range("A2", DerLg(1, 5)) 'si lignes de titre en ligne 1
End With
u = 0
For x = 1 To UBound(Tb1, 1)
  For y = 1 To UBound(Tb2, 1)
    If Tb1(x, 1) = Tb2(y, 1) Then
      u = u + 1
      ReDim Preserve Tbtemp(1 To u)
      Tbtemp(u) = Tb1(x, 1) & ";" & Tb1(x, 2) & ";" & Tb1(x, 3) & ";" & Tb1(x, 4) & ";" & Tb1(x, 5)
    End If
  Next y
Next x
ReDim TbResult(1 To UBound(Tbtemp), 1 To CelGardee)
 
For x = 1 To UBound(Tbtemp)
  For y = 1 To CelGardee
    TbResult(x, y) = Split(Tbtemp(x), ";")(y - 1)
  Next y
Next x
With Sheets("Feuil3")
  Set DerCol = .Cells(1, .Columns.Count).End(xlToLeft)
  Set DerLg = .Cells(.Rows.Count, DerCol.Column).End(xlUp)
  If DerLg.Row > 1 Then .Range("A2", DerLg(1, DerCol.Column)).ClearContents
  If DerCol.Column > CelGardee Then .Range(Cells(1, CelGardee + 1), Cells(1, DerCol.Column)).ClearContents
  .Range("A2").Resize(UBound(TbResult, 1), CelGardee) = TbResult
End With
Erase Tbtemp
End Sub

[casefayere]

j'avais oublié une chose, pour le confort, donc, toujours sur la même base (3 feuilles, Feuil1 et Feuil2 comparées, Feuil3 pour le résultat)

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
Sub appel1()
Dim x As Long, Tb1, Tb2, Tbtemp(), TbResult(), DerLg As Range
Dim u As Long, CelGardee As Integer
Dim y As Long, DerCol As Range
'j'imagine un tableau en Feuil1 (A à E)
'un tableau en Feuil2 (A à E)
'le resultat en Feuil3 (A à E)
'les valeurs à comparer en A
CelGardee = InputBox("combien de colonnes à garder")
With Sheets("Feuil1")
  Set DerLg = .Range("A" & .Rows.Count).End(xlUp)
  Tb1 = .Range("A2", DerLg(1, 5)) 'si lignes de titre en ligne 1
End With
With Sheets("Feuil2")
  Set DerLg = .Range("A" & .Rows.Count).End(xlUp)
  Tb2 = .Range("A2", DerLg(1, 5)) 'si lignes de titre en ligne 1
End With
u = 0
For x = 1 To UBound(Tb1, 1)
  For y = 1 To UBound(Tb2, 1)
    If Tb1(x, 1) = Tb2(y, 1) Then
      u = u + 1
      ReDim Preserve Tbtemp(1 To u)
      Tbtemp(u) = Tb1(x, 1) & ";" & Tb1(x, 2) & ";" & Tb1(x, 3) & ";" & Tb1(x, 4) & ";" & Tb1(x, 5)
    End If
  Next y
Next x
ReDim TbResult(1 To UBound(Tbtemp), 1 To CelGardee)
 
For x = 1 To UBound(Tbtemp)
  For y = 1 To CelGardee
    TbResult(x, y) = Split(Tbtemp(x), ";")(y - 1)
  Next y
Next x
With Sheets("Feuil3")
  Set DerCol = .Cells(1, .Columns.Count).End(xlToLeft)
  Set DerLg = .Cells(.Rows.Count, DerCol.Column).End(xlUp)
  If DerLg.Row > 1 Then .Range("A1", DerLg(1, DerCol.Column)).ClearContents
  If DerCol.Column > CelGardee Then .Range(Cells(1, CelGardee + 1), Cells(1, DerCol.Column)).ClearContents
  .Range("A2").Resize(UBound(TbResult, 1), CelGardee) = TbResult
  For x = 1 To CelGardee
    .Cells(1, x) = Sheets("Feuil1").Cells(1, x)
  Next x
End With
Erase Tbtemp
End Sub

[lysander31]

Mon tableau ou je recherche mes valeurs ressemble a ça
Nom code couleur taille

je teste en fonction de la colonne code et si c'est bon je garde une des autres cellules par exemple en admettant que l'on compare les colonnes B je voudrai garder seulement la cellule A ou seulement les cellules C et D

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
 
Sub nouveau_code()
Application.ScreenUpdating = False
Dim x As Long, Tb1, Tb2, Tbtemp(), TbResult(), DerLg As Range
Dim u As Long
Dim y As Long
 
With Sheets("comparatif")
  Set DerLg = .Range("AB" & .Rows.Count).End(xlUp)
  Tb1 = .Range("U5", DerLg(4, 200))
End With
With Sheets("codes")
  Set DerLg = .Range("C" & .Rows.Count).End(xlUp)
  Tb2 = .Range("C6", DerLg(6, 200))
End With
u = 0
For x = 1 To UBound(Tb1, 1)
  For y = 1 To UBound(Tb2, 1)
    If Tb1(x, 1) = Tb2(y, 1) Then
      u = u + 1
      ReDim Preserve Tbtemp(1 To u)
      Tbtemp(u) = Tb1(x, 27) & ";"
    End If
  Next y
Next x
ReDim TbResult(1 To UBound(Tbtemp), 1 To 27)
 
For x = 1 To UBound(Tbtemp)
  For y = 1 To 27
    TbResult(x, y) = Split(Tbtemp(x), ";")(y - 1)
  Next y
Next x
With Sheets("codes")
  Set DerLg = .Range("AA" & .Rows.Count).End(xlUp)
  If DerLg.Row > 1 Then .Range("B6", DerLg).ClearContents
  .Range("B6").Resize(UBound(TbResult, 1), 27) = TbResult
End With
Erase Tbtemp
End Sub

la ça me dit l'indice n'appartient pas a la sélection pour la ligne TbResult(x, y) = Split(Tbtemp(x), ";")(y - 1)

[casefayere]

Peu importe la structure de ton fichier, tu devrais pouvoir adapter mon dernier exemple

[lysander31]

ok merci ça marche pour les cellules qui sont après la cellule testé mais si je veux une cellule qui se trouve avant ca ne marche pas

[casefayere]

Comme j'ai dit, il suffit d'adapter, plutot que de perdre du temps, envoies un fichier bidon avec tes structures de feuille, je corrigerai ton code et te l'expliquerai par la même occasion, si tu es patient

[lysander31]

voila le fichier j'ai pas pu mettre la macro le site me met fichier non valide je voudrai récupérer test en testant les codes
merci

[casefayere]

j'ai pas pu mettre la macro le site me met fichier non valide je voudrai récupérer test en testant les codes

il faut, soit le convertir en Excel 2003 (.xls), soit le compresser et l'envoyer en Zip, mais je vais déjà regarder ton fichier en espérant comprendre la problématique.

Il me faut une précision

...en admettant que l'on compare les colonnes B je voudrai garder seulement la cellule A ou seulement les cellules C et D

Quand la cellule en B (feuil1) = cellule en B (feuil2), que gardes-tu ? A , C et D ?, en fonction de quoi ?, par contre, on est bien d'accord, si tu ne trouves pas la correspondance, on supprime la ligne ?

[lysander31]

quand B feuille 1 = B feuille 2 je garde A feuille 1 ( j'ai compris comment garder B C D etc)
quand B feuille 1 différent de B feuille 2 je supprime tout

[casefayere]

Essayes ce fichier, tu enlèveras par la suite l'InputBox s'il ne sert à rien et si les cellules à copier seront toujours les mëmes, il faudra simplement adapter la variable "CelGardee"

Je t'enverrai le code avec explications si ça te va

[lysander31]

merci beaucoup ça marche j'ai réussi a l'intégrer dans mes tableaux. Merci pour ta patience et ton aide