Comparaison de 2 colonnes

**auriga69** · 18/05/2015, 16h08

Bonjour,

On vient de me demander de dépanner une macro qui ne fonctionne pas .....
Elle a pour but de comparer les valeurs (chiffres et lettres) des cellules de 2 colonnes (A) dans 2 feuilles différentes ( feuil2 et Feuil3) dans 2 classeurs (Encours-CTI et Classeurs2).
Des qu'une valeur est identique, nous voulons une copie des cellules B à T de la ligne concernée dans Feuil2 vers H de la ligne concernée de la Feuil3.

Quand je lance cette macro (située dans le classeur Encours-CTI), rien ne se passe, Execl est figé .. bref j'ai l'impression que cela tourne en boucle. je suis obligé d’arrêter l’exécution au bout de plusieurs minutes.

Quelqu'un peut me donner un coup de main ? Merci

le code :

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
Sub comparaison()
'
' comparaison Macro
'
'
Dim VALEURA As String, VALEURB As String
'
For i = 2 To 5000
VALEURA = Worksheets("Feuil2").Range("A" & i).Value
For j = 2 To 5000
VALEURB = Workbooks("Encours-CTI.xls").Worksheets("Feuil3").Range("A" & j).Value
If VALEURA = VALEURB Then
Workbooks("Encours-CTI.xls").Worksheets("Feuil3").Range(Range("B" & j), Range("T" & j)).Copy
Workbooks("Classeur2.xlsm").Worksheets("Feuil2").Range("H" & i).Paste
End If
Next j
Next i
End Sub

**Gado2600** · 18/05/2015, 17h24

Bonjour,

C'est un peu normal que cela soit long car, de ce que je lis, tu fais une double boucle sur 4999 lignes, soit 24 990 001 comparaisons...

Deux choses en particulier qui pourraient accélérer le processus :
- serait de passer tes données dans des tableaux "virtuels" (cf. Dim tabA() as variant)
- plutôt que de dire "de 2 jusqu'à 5000", dis plutôt "de 2 à ma dernière ligne renseignée" (cf. Worksheets("Feuil2").Range("A5001").end(xlUp).row)

Le premier point accélère énormément les comparaisons de données et le second point t'économisera éventuellement, quelques millions de comparaisons. Selon la quantité de tes données, on pourrait estimer diviser par 2 le nombre de lignes par boucles (soit 2500*2500 => 6 250 000 comparaisons).

Cordialement,

**Thautheme** · 18/05/2015, 17h40

Bonjour le fil, bonjour le forum,

Le code ci-dessous quand une occurrence est identique ne continue pas la seconde boucle. Je ne sais pas si c'est ce que tu veux mais cela va accélérer son exécution.

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
Sub comparaison()
Dim C1 As Workbook
Dim C2 As Workbook
Dim O1 As Worksheet
Dim O2 As Worksheet
Dim VALEURA As String
Dim VALEURB As String
 
Set C1 = ThisWorkbook
Set O1 = C1.Sheets("Feuil2")
Set C2 = Workbooks("Encours-CTI.xls")
Set O2 = C2.Sheets("Feuil3")
For I = 2 To 5000
    VALEURA = CStr(O1.Cells(I, 1).Value)
    For J = 2 To 5000
        VALEURB = CStr(O2.Cells(J, 1).Value)
        If VALEURA = VALEURB Then O2.Cells(J, 2).resise(1, 19).Copy O1.Cells(I, 8)
        Exit For
    Next J
Next I
End Sub

Mais je suis tout à fait d'accord avec Gado et te propose une version avec des variables tableaux :

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
Sub comparaison2()
Dim C1 As Workbook
Dim C2 As Workbook
Dim O1 As Worksheet
Dim O2 As Worksheet
Dim TC1 As Variant
Dim TC2 As Variant
Dim TL() As Variant
 
Set C1 = ThisWorkbook
Set O1 = C1.Sheets("Feuil2")
Set C2 = Workbooks("Encours-CTI.xls")
Set O2 = C2.Sheets("Feuil3")
TC1 = O1.Range("A1").CurrentRegion
TC2 = O2.Range("A1").CurrentRegion
For I = 2 To UBound(TC1, 1)
    K = 1
    For J = 2 To UBound(TC2, 1)
        If CStr(TC1(I, 1)) = CStr(TC2(J, 1)) Then
            ReDim Preserve TL(1 To 19, 1 To K)
            For L = 1 To 19
                TC(L, K) = TC2(L + 1, J)
            Next I
            K = K + 1
            If K > 1 Then O1.Cells(I, 8).resise(1, 19).Value = Application.Transpose(TL)
            Exit For
        End If
    Next J
Next I
End Sub

**auriga69** · 19/05/2015, 09h58

Bonjour à tous,

Merci à Gado et Thautheme pour vos réponses.

Je viens de copier le code (le dernier avec les variables tableaux) puis de le lancer .. j'ai une erreur sur la ligne 22 avec le code 9 l'indice n'appartient pas à la sélection.

Merci de me donner un petit coup de main

Auriga

**Gado2600** · 19/05/2015, 10h28

Bonjour,

C'est fort possible d'après ce que je vois (sauf si je suis mal réveillé...) :
TC(L, K) n'est pas une variable déclarée et je ne vois nulle part d'attribution de données dedans ni de dimensionnement.

Mais c'est une hypothèse par rapport au post précédent. Comme on n'a pas le code que tu as "adapté", on ne peut pas t'aider dessus. Le mode pas-à-pas (F8 et le point d'arrêt F9) existe et pourrait te permettre d'identifier la partie qui pose problème et de remonter à sa source.

Cordialement,

**auriga69** · 19/05/2015, 11h29

Bonjour,

J'ai remplacé TC(L, K) par TL(L,K) .. voici le code que j'ai utilisé

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
 
 
 Sub comparaison()
Dim C1 As Workbook
Dim C2 As Workbook
Dim O1 As Worksheet
Dim O2 As Worksheet
Dim TC1 As Variant
Dim TC2 As Variant
Dim TL() As Variant
 
Set C1 = ThisWorkbook
Set O1 = C1.Sheets("Feuil2")
Set C2 = Workbooks("Encours-CTI.xls")
Set O2 = C2.Sheets("Feuil3")
TC1 = O1.Range("A1").CurrentRegion
TC2 = O2.Range("A1").CurrentRegion
For i = 2 To UBound(TC1, 1)
    k = 1
    For j = 2 To UBound(TC2, 1)
        If CStr(TC1(i, 1)) = CStr(TC2(j, 1)) Then
            ReDim Preserve TL(1 To 19, 1 To k)
            For L = 1 To 19
                TL(L, k) = TC2(L + 1, j)
            Next
            k = k + 1
            If k > 1 Then O1.Cells(i, 8).resise(1, 19).Value = Application.Transpose(TL)
            Exit For
        End If
    Next j
Next i
End Sub

A priori l'erreur se situe sur la ligne 22 mais pour TC2(L + 1, j)

Merci pour l'aide

**Gado2600** · 19/05/2015, 11h52

Hum... Je vois...

Il y a une incohérence dans les indices :
Tu as :

Code :

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

 CStr(TC2(j, 1))

et :

Code :

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

TC2(L + 1, j)

Cordialement,

**Philippe Tulliez** · 19/05/2015, 12h19

Bonjour,
Une autre solution est l'utilisation des formules d'excel placées sur la plage cible par le code VBA et transformées ensuite par leurs valeurs
Dans l'exemple les deux feuilles sont dans le même classeur, (il suffit de modifier les lignes 15 et 16 de la procédure).
La plage "source" est $A$2:$E$27 de la feuille nommée [db2] et la plage "cible" est $A$2:$J$106 de la feuille nommée [db1]
La copie des données se fait à partir de la colonne 2 de la plage "source" vers la colonne L (déplacement de 2 colonnes par rapport à colonne J) de la plage "cible" si les références contenues dans les colonnes A de la plage "source" sont présentes dans la plage "cible".
Le déplacement de la colonne est défini par la constante ColumnOffset (ligne 11 de la procédure)
La formule d'excel est

Code :

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

=SIERREUR(INDEX('db2'!$A$2:$E$27;EQUIV($A2;'db2'!$A$2:$A$27;0);COLONNE(L$1)-COLONNE($L$1)+2);"")

en VBA

Code :

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

=IFERROR(INDEX('db2'!$A$2:$E$27,MATCH($A2,'db2'!$A$2:$A$27,0),COLUMN(L$1)-COLUMN($L$1)+2),"")

J'utilise des balises pour que les plages "source" et "cible" soient calculées automatiquement

Code :

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

"=IFERROR(INDEX(<dbSource>,MATCH($A2,<dbSourceKey>,0),COLUMN(<dbTargetColumnStartM>)-COLUMN(<dbTargetColumnStart>)+2),"""")"

Voir explications dans ces deux billets Ecrire une formule dans Excel à l'aide d'une procédure VBA et la suite Ecrire une formule dans Excel à l'aide d'une procédure VBA (Part 2)
Le format n'est pas copié

Code de la procédure

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
Sub CopyColumns()
 ' Copie des colonnes 2 à nombre de colonnes de la plage "Source"
 '   vers les colonnes de la plage "Cible" (la colonne de départ est définie par ColumnOffset
 '   si les références contenues en colonne A des plages "Source" et "Cible" sont présentes
 
 ' Déclaration variables et constantes + attribution des valeurs aux variables
 ' ColumnOffset = Colonne cible (déplacement par rapport à la plage cible)
 ' Exemple :
 ' si l'on veut copier les données à partir de la colonne L et la plage est A1:J500
 ' ColumnOffset = 2
 Const ColumnOffset As Integer = 2 ' Colonne cible (déplacement par rapport à la plage cible)
 Dim rngSource As Range, rngTarget As Range
 Dim myFormula As String
 myFormula = "=IFERROR(INDEX(<dbSource>,MATCH($A2,<dbSourceKey>,0),COLUMN(<dbTargetColumnStartM>)-COLUMN(<dbTargetColumnStart>)+2),"""")"
 Set rngTarget = ThisWorkbook.Worksheets("db1").Range("A1").CurrentRegion
 Set rngSource = ThisWorkbook.Worksheets("db2").Range("A1").CurrentRegion
 With rngSource: Set rngSource = .Offset(1).Resize(.Rows.Count - 1): End With
 With rngTarget: Set rngTarget = .Offset(1).Resize(.Rows.Count - 1): End With
 ' Modification de la formule avec les addresses de rngTarget
 myFormula = Replace(myFormula, "<dbSource>", rngSource.Address(external:=True))
 myFormula = Replace(myFormula, "<dbSourceKey>", rngSource.Columns(1).Address(external:=True))
 myFormula = Replace(myFormula, "<dbTargetColumnStart>", Cells(1, rngTarget.Columns.Count + ColumnOffset).Address)
 myFormula = Replace(myFormula, "<dbTargetColumnStartM>", Cells(1, rngTarget.Columns.Count + ColumnOffset).Address(columnabsolute:=False))
 ' Copie de la formule dans plage cible (rngTarget)
 With rngTarget
  With .Offset(ColumnOffset:=.Columns.Count + ColumnOffset - 1).Resize(columnsize:=rngSource.Columns.Count - 1)
  .Formula = myFormula
  .Value = .Value  ' Transforme les formules en valeur
  End With
 End With
 '
 Set rngSource = Nothing: Set rngTarget = Nothing
End Sub

Attention : La formule SIERREUR ne fonctionne pas avec les versions antérieures à 2007. Il y aurait lieu alors d'utiliser ESTNA imbriquée dans un SI

**auriga69** · 19/05/2015, 15h22

Bonjour Philippe,

merci pour ton explication.

J'ai copié ton code complet, modifié les lignes 15 et 16, et la ligne 11 à 7 car je veux copier les colonnes à partir de B ( jusqu'à M) de la source vers la colonne H de la cible ... si la valeur de cellule Ax source est égale à Ax de la cible ...
Exécution du code mais rien ne se passe, pas d'erreur ni copie ....

Voici le code que j'ai exécuté ...

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
 
Sub CopyColumns()
 ' Copie des colonnes 2 à nombre de colonnes de la plage "Source"
 '   vers les colonnes de la plage "Cible" (la colonne de départ est définie par ColumnOffset
 '   si les références contenues en colonne A des plages "Source" et "Cible" sont présentes
 
 ' Déclaration variables et constantes + attribution des valeurs aux variables
 ' ColumnOffset = Colonne cible (déplacement par rapport à la plage cible)
 ' Exemple :
 ' si l'on veut copier les données à partir de la colonne L et la plage est A1:J500
 ' ColumnOffset = 2
 Const ColumnOffset As Integer = 7 ' Colonne cible (déplacement par rapport à la plage cible)
 Dim rngSource As Range, rngTarget As Range
 Dim myFormula As String
 myFormula = "=IFERROR(INDEX(<dbSource>,MATCH($A2,<dbSourceKey>,0),COLUMN(<dbTargetColumnStartM>)-COLUMN(<dbTargetColumnStart>)+2),"""")"
 Set rngTarget = ThisWorkbook.Worksheets("Feuil2").Range("A2").CurrentRegion
 Set rngSource = Workbooks("Encours-CTI.xls").Worksheets("Feuil3").Range("A2").CurrentRegion
 With rngSource: Set rngSource = .Offset(1).Resize(.Rows.Count - 1): End With
 With rngTarget: Set rngTarget = .Offset(1).Resize(.Rows.Count - 1): End With
 ' Modification de la formule avec les addresses de rngTarget
 myFormula = Replace(myFormula, "<dbSource>", rngSource.Address(external:=True))
 myFormula = Replace(myFormula, "<dbSourceKey>", rngSource.Columns(1).Address(external:=True))
 myFormula = Replace(myFormula, "<dbTargetColumnStart>", Cells(1, rngTarget.Columns.Count + ColumnOffset).Address)
 myFormula = Replace(myFormula, "<dbTargetColumnStartM>", Cells(1, rngTarget.Columns.Count + ColumnOffset).Address(columnabsolute:=False))
 ' Copie de la formule dans plage cible (rngTarget)
 With rngTarget
  With .Offset(ColumnOffset:=.Columns.Count + ColumnOffset - 1).Resize(columnsize:=rngSource.Columns.Count - 1)
  .Formula = myFormula
  .Value = .Value  ' Transforme les formules en valeur
  End With
 End With
 '
 Set rngSource = Nothing: Set rngTarget = Nothing
End Sub

**Philippe Tulliez** · 19/05/2015, 16h02

Bonjour,
Par acquit de conscience, j'ai placé la source également sur un autre classeur et la procédure a fonctionné parfaitement.
La première vérification à faire est de savoir si les formules sont bien copiées au bon endroit.
Je propose donc de mettre une apostrophe devant la ligne 29, de lancer la procédure et de vérifier si les formules sont bien présentes sur la feuille où se trouve la plage cible.
Ajouter également après la ligne 31, la ligne suivante pour savoir si les adresses des plages sont correctes

Code :

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

 MsgBox rngTarget.Address(external:=True) & vbCrLf & rngSource.Address(external:=True)

**auriga69** · 19/05/2015, 16h44

Philippe,

Désolé pour le message précédent mais ton code fonctionne ... sauf qu'il copie les cellules à partir de la colonne AG de la cible .... à la place de la colonne H.

De plus comme tu l'avais indiqué, le format des cellules n'est pas conservé . As tu une idée pour que cela copie les cellules avec leur format (couleur,date, vide sans 0 ...)

merci pour ton aide

Auriga

**Thautheme** · 19/05/2015, 18h20

Bonjour le fil, bonjour le forum,

Désolé mais le code proposé navet (si, si, dans ce cas on peut...) pas été testé et, comme l'a dit Gado, il comportait des incohérences...

Code :

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

TL(L, K) = TC2(J, L + 1)

**Philippe Tulliez** · 19/05/2015, 18h41

Bonjour Auriga,

Désolé pour le message précédent mais ton code fonctionne ... sauf qu'il copie les cellules à partir de la colonne AG de la cible .... à la place de la colonne H.

Peut-être me suis-je mal exprimé mais j'ai pourtant donné un exemple dans les commentaires.
Si la constante ColumnOffset a comme valeur 7, cela signifie que le déplacement est de 7 colonnes par rapport à la dernière colonne de la plage cible. Soit si la plage est en A1:M5000 7 nous renverra à la colonne T.

Il faut vérifier en sélectionnant une cellule de la plage cible (de préférence la première cellule) et faire Ctrl+A ou Ctrl+* (C'est ce que fait la propriété CurrentRegion).
Après avoir supprimer des valeurs d'une ou des dernières colonnes et/ou dernières lignes, Excel considère encore ces colonnes ou lignes comme étant remplies. Il faut enregistrer le classeur pour que tout rendre dans l'ordre.

Pour ce qui est du format des cellules, un simple Copier/CollageSpecial - Format de la plage "source" sur la plage où se trouve les cellules suffira.

**Marc-L** · 19/05/2015, 18h52

Envoyé par Philippe Tulliez

Après avoir supprimer des valeurs d'une ou des dernières colonnes et/ou dernières lignes, Excel considère encore ces colonnes ou lignes comme étant remplies. Il faut enregistrer le classeur pour que tout rendre dans l'ordre.

Bonjour,

souvent la propriété UsedRange "à vide" suffit, du genre une ligne de code Feuil3.UsedRange …

_____________________________________________________________________________________________________
Je suis Charlie - Je suis Bardo

**Philippe Tulliez** · 19/05/2015, 19h10

Bonjour Marc,

souvent la propriété UsedRange "à vide" suffit, du genre une ligne de code Feuil3.UsedRange …

La propriété UsedRange se comporte malheureusement comme CurrentRegion lorsque l'on supprime les valeurs sans avoir sauvé le classeur après la suppression.
Je viens même de constater à l'instant qu'après avoir fermé le classeur et l'avoir ouvert à nouveau la propriété CurrentRegion tenait compte de la nouvelle plage alors que UsedRange me sélectionnait encore les colonnes vides
Je trouve pour ma part que c'est une propriété plus dangereuse pour cette raison que CurrentRegion. Il y a aussi les risques où l'utilisateur aurait plus d'un tableau dans sa feuille et c'est le problème assuré.

**Marc-L** · 20/05/2015, 12h24

Oui effectivement et j'aurais dû préciser sans mise en forme des cellules, sinon UsedRange ne change pas …

Comparaison de 2 colonnes

Macros et VBA Excel

Discussions similaires

Partager

Partager