Accélération de code de comparaison entre 2 feuilles

Bonjour,

As-tu essayé comme ceci :

Dans la procédure suivante, "Feuil1", "Feuil2" et "Feuil3" représente la propriété
"Name" des objets "Feuille" visibles seulement dans la fenêtre l'éditeur de code.
Ce ne sont pas les noms des onglets des feuilles de calcul.

Tu devras les adapter selon ton environnement.

'------------------------------------------------
Sub test()
Dim T As Variant, T1 As Variant
Dim G As Long, T2(), A As Long

With Feuil1
T = .Range("A2:A" & .Cells(.Rows.Count, 1).End(xlUp).Row)
End With
With Feuil2
T1 = .Range("A2:A" & .Cells(.Rows.Count, 1).End(xlUp).Row)
End With

For A = LBound(T, 1) To UBound(T, 1)
If Not IsNumeric(Application.Match(T(A, 1), T1, 0)) Then
G = G + 1
ReDim Preserve T2(1 To G)
T2(G) = T(A, 1)
Else
Err.Clear
End If
Next
Application.EnableEvents = False
Application.ScreenUpdating = False
Feuil3.Range("A2").Resize(UBound(T2, 1)) = Application.Transpose(T2)
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
End Sub
'------------------------------------------------



MichD
---------------------------------------------------------------
"khinoa" a écrit dans le message de groupe de discussion :
5022983b$0$23532$426a74cc@news.free.fr...

Bonjour à tous,

Je voudrais comparer deux feuilles de 17 000 lignes environ et copier dans
une 3ème feuille les lignes de la feuille 2 dont le contenu de la cellule en
colonne A n'a pas été trouvée dans une autre cellule en colonne A de la
feuille 1. le
nombre de lignes évolue à la hausse chaque jour. Avec Excel 2010 il y a
certes 1 048 576 lignes mais peut-on vraiment les remplir toutes sans
risques de ralentissement notable ?

J'utilise déjà le code suivant qui fonctionne très bien sur des petits
nombres de lignes mais il est lent pour 17 000 lignes (environ 2 à 3
minutes).

Sub Comparaison()

Dim c As Range

On Error Resume Next

Application.ScreenUpdating = False
Sheets("BASE1").Activate

For Each c In Range("a2", Range("a1048576").End(3))
Sheets("BASE2").Activate
If Range("a2", Range("a1048576").End(3)).Find(c, Range("a2")) Is Nothing
Then
c.EntireRow.Copy Sheets("BASE3").Range("a1048576").End(3) (2)
End If
Next
End Sub

Je sais que l'on peut utiliser des tableaux en mémoire pour accélérer le
code. Mais les valeurs de la colonne A des deux feuilles à comparer
n'étant naturellement pas sur la même ligne, un code de type

Tblo1 = Sheets("BASE1").Range("a2:a1000000")
Tblo2 = Sheets("BASE2").Range("a2:a1000000")

Application.ScreenUpdating = False
For a = 1 To UBound(Tblo1, 1)
If Tblo1(a, 1) <> Tblo2(a,1) Then
Sheets("BASE3").Cells(a, 1) = Tblo1
End If
Next
Next

n'est d'aucune utilité tel quel car il compare deux cellules situées sur la
même ligne ce qui ne sera quasiment jamais le cas dans ma base de données.
Comment faire un mélange des deux codes, si c'est possible, pour avoir
l'exécution la plus rapide ?

D'avance merci à tous

khinoa

Tu peux utiliser une autre approche qui devrait être très rapide...

Elle utilise une formule et la plage obtenue en Feuil3 sera triée en ordre croissant.

Même chose que pour l'autre procédure, tu dois adapter le nom des feuilles.

Dans les 2 feuilles, j'ai supposé que les données débutaient sur la ligne 2,
la ligne 1 étant réservé à l'étiquette de colonne, il en est ainsi en feuil3.

'------------------------------------------------
Sub Test1()
Dim Rg As Range, Rg1 As Range

With Feuil1
Set Rg = .Range("A2:A" & .Cells(.Rows.Count, 1).End(xlUp).Row)
End With
With Feuil2
Set Rg1 = .Range("A2:A" & .Cells(.Rows.Count, 1).End(xlUp).Row)
End With

Application.EnableEvents = False
Application.ScreenUpdating = False

With Feuil3
With .Range("A2")
.Formula = "=IF(COUNTIF(" & Rg1.Parent.Name & "!" & _
Rg1.Address & "," & Rg.Parent.Name & _
"!A2)=0," & Rg.Parent.Name & "!A2,"""")"
With .Resize(Rg.Rows.Count)
.FillDown
.Value = .Value
.Sort Key1:=.Item(1, 1), order1:=xlAscending
End With
End With
End With

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub
'------------------------------------------------





MichD
---------------------------------------------------------------
"khinoa" a écrit dans le message de groupe de discussion :
5022983b$0$23532$426a74cc@news.free.fr...

Bonjour à tous,

Je voudrais comparer deux feuilles de 17 000 lignes environ et copier dans
une 3ème feuille les lignes de la feuille 2 dont le contenu de la cellule en
colonne A n'a pas été trouvée dans une autre cellule en colonne A de la
feuille 1. le
nombre de lignes évolue à la hausse chaque jour. Avec Excel 2010 il y a
certes 1 048 576 lignes mais peut-on vraiment les remplir toutes sans
risques de ralentissement notable ?

J'utilise déjà le code suivant qui fonctionne très bien sur des petits
nombres de lignes mais il est lent pour 17 000 lignes (environ 2 à 3
minutes).

Sub Comparaison()

Dim c As Range

On Error Resume Next

Application.ScreenUpdating = False
Sheets("BASE1").Activate

For Each c In Range("a2", Range("a1048576").End(3))
Sheets("BASE2").Activate
If Range("a2", Range("a1048576").End(3)).Find(c, Range("a2")) Is Nothing
Then
c.EntireRow.Copy Sheets("BASE3").Range("a1048576").End(3) (2)
End If
Next
End Sub

Je sais que l'on peut utiliser des tableaux en mémoire pour accélérer le
code. Mais les valeurs de la colonne A des deux feuilles à comparer
n'étant naturellement pas sur la même ligne, un code de type

Tblo1 = Sheets("BASE1").Range("a2:a1000000")
Tblo2 = Sheets("BASE2").Range("a2:a1000000")

Application.ScreenUpdating = False
For a = 1 To UBound(Tblo1, 1)
If Tblo1(a, 1) <> Tblo2(a,1) Then
Sheets("BASE3").Cells(a, 1) = Tblo1
End If
Next
Next

n'est d'aucune utilité tel quel car il compare deux cellules situées sur la
même ligne ce qui ne sera quasiment jamais le cas dans ma base de données.
Comment faire un mélange des deux codes, si c'est possible, pour avoir
l'exécution la plus rapide ?

D'avance merci à tous

khinoa

Bonjour MichD,

Je te remercie de ta réponse rapide. Je vais essayer ce code demain matin
et je placerai un minuteur (Timer) pour voir combien de temps ce code prend
par rapport à celui dont je me sers actuellement.

C'est vrai que les tableaux ont toujours été et restent encore pour moi
quelque chose de difficile à comprendre. Je n'avais jamais pensé en outre à
utiliser Application.Match.

A demain en fin d'après-midi pour un compte rendu.

khinoa


"MichD" a écrit dans le message de groupe de discussion :
jvu9mc$p25$1@speranza.aioe.org...

Bonjour,

As-tu essayé comme ceci :

Dans la procédure suivante, "Feuil1", "Feuil2" et "Feuil3" représente la
propriété
"Name" des objets "Feuille" visibles seulement dans la fenêtre l'éditeur de
code.
Ce ne sont pas les noms des onglets des feuilles de calcul.

Tu devras les adapter selon ton environnement.

'------------------------------------------------
Sub test()
Dim T As Variant, T1 As Variant
Dim G As Long, T2(), A As Long

With Feuil1
T = .Range("A2:A" & .Cells(.Rows.Count, 1).End(xlUp).Row)
End With
With Feuil2
T1 = .Range("A2:A" & .Cells(.Rows.Count, 1).End(xlUp).Row)
End With

For A = LBound(T, 1) To UBound(T, 1)
If Not IsNumeric(Application.Match(T(A, 1), T1, 0)) Then
G = G + 1
ReDim Preserve T2(1 To G)
T2(G) = T(A, 1)
Else
Err.Clear
End If
Next
Application.EnableEvents = False
Application.ScreenUpdating = False
Feuil3.Range("A2").Resize(UBound(T2, 1)) = Application.Transpose(T2)
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
End Sub
'------------------------------------------------



MichD
---------------------------------------------------------------
"khinoa" a écrit dans le message de groupe de discussion :
5022983b$0$23532$426a74cc@news.free.fr...

Bonjour à tous,

Je voudrais comparer deux feuilles de 17 000 lignes environ et copier dans
une 3ème feuille les lignes de la feuille 2 dont le contenu de la cellule en
colonne A n'a pas été trouvée dans une autre cellule en colonne A de la
feuille 1. le
nombre de lignes évolue à la hausse chaque jour. Avec Excel 2010 il y a
certes 1 048 576 lignes mais peut-on vraiment les remplir toutes sans
risques de ralentissement notable ?

J'utilise déjà le code suivant qui fonctionne très bien sur des petits
nombres de lignes mais il est lent pour 17 000 lignes (environ 2 à 3
minutes).

Sub Comparaison()

Dim c As Range

On Error Resume Next

Application.ScreenUpdating = False
Sheets("BASE1").Activate

For Each c In Range("a2", Range("a1048576").End(3))
Sheets("BASE2").Activate
If Range("a2", Range("a1048576").End(3)).Find(c, Range("a2")) Is Nothing
Then
c.EntireRow.Copy Sheets("BASE3").Range("a1048576").End(3) (2)
End If
Next
End Sub

Je sais que l'on peut utiliser des tableaux en mémoire pour accélérer le
code. Mais les valeurs de la colonne A des deux feuilles à comparer
n'étant naturellement pas sur la même ligne, un code de type

Tblo1 = Sheets("BASE1").Range("a2:a1000000")
Tblo2 = Sheets("BASE2").Range("a2:a1000000")

Application.ScreenUpdating = False
For a = 1 To UBound(Tblo1, 1)
If Tblo1(a, 1) <> Tblo2(a,1) Then
Sheets("BASE3").Cells(a, 1) = Tblo1
End If
Next
Next

n'est d'aucune utilité tel quel car il compare deux cellules situées sur la
même ligne ce qui ne sera quasiment jamais le cas dans ma base de données.
Comment faire un mélange des deux codes, si c'est possible, pour avoir
l'exécution la plus rapide ?

D'avance merci à tous

khinoa

Petite correction :

Cette section de la procédure :
'------------------------
If Not IsNumeric(Application.Match(T(A, 1), T1, 0)) Then
G = G + 1
ReDim Preserve T2(1 To G)
T2(G) = T(A, 1)
Else
Err.Clear
End If
'------------------------

devrait être remplacé par :

'------------------------
If Not IsNumeric(Application.Match(T(A, 1), T1, 0)) Then
Err.Clear
G = G + 1
ReDim Preserve T2(1 To G)
T2(G) = T(A, 1)
End If
'------------------------


MichD
---------------------------------------------------------------

Juste une précision. Dans mon code je récupérais le contenu de la ligne
(EntireRow) dont la valeur en colonne A de la feuille BASE2 était
introuvable en colonne A de la feuille BASE1. Ton code apparemment ne
renvoie que la valeur non trouvée de la colonne A. Est-il possible de
récupérer la totalité de la ligne ?

khinoa

"MichD" a écrit dans le message de groupe de discussion :
jvucu7$s6$1@speranza.aioe.org...

Petite correction :

Cette section de la procédure :
'------------------------
If Not IsNumeric(Application.Match(T(A, 1), T1, 0)) Then
G = G + 1
ReDim Preserve T2(1 To G)
T2(G) = T(A, 1)
Else
Err.Clear
End If
'------------------------

devrait être remplacé par :

'------------------------
If Not IsNumeric(Application.Match(T(A, 1), T1, 0)) Then
Err.Clear
G = G + 1
ReDim Preserve T2(1 To G)
T2(G) = T(A, 1)
End If
'------------------------


MichD
---------------------------------------------------------------

Comme pour ton précédent code, je testerai demain. Avec Excel, je dis
souvent qu'il n'y a pas de problèmes, que des solutions. Sauf que les
tiennes, je ne les connaissais pas et que ton code me laisse pantois. Il
faut que j'essaie de le comprendre, lui comme le précédent, sinon aucun
progrès pour moi n'est possible. Toute explication de code sera bien entendu
la bienvenue.

Dans ton code que remplace Parent ? Feuil3 ?

Merci pour tes codes qui restent encore un peu mystérieux



"MichD" a écrit dans le message de groupe de discussion :
jvuc2g$uk2$1@speranza.aioe.org...

Tu peux utiliser une autre approche qui devrait être très rapide...

Elle utilise une formule et la plage obtenue en Feuil3 sera triée en ordre
croissant.

Même chose que pour l'autre procédure, tu dois adapter le nom des feuilles.

Dans les 2 feuilles, j'ai supposé que les données débutaient sur la ligne 2,
la ligne 1 étant réservé à l'étiquette de colonne, il en est ainsi en
feuil3.

'------------------------------------------------
Sub Test1()
Dim Rg As Range, Rg1 As Range

With Feuil1
Set Rg = .Range("A2:A" & .Cells(.Rows.Count, 1).End(xlUp).Row)
End With
With Feuil2
Set Rg1 = .Range("A2:A" & .Cells(.Rows.Count, 1).End(xlUp).Row)
End With

Application.EnableEvents = False
Application.ScreenUpdating = False

With Feuil3
With .Range("A2")
.Formula = "=IF(COUNTIF(" & Rg1.Parent.Name & "!" & _
Rg1.Address & "," & Rg.Parent.Name & _
"!A2)=0," & Rg.Parent.Name & "!A2,"""")"
With .Resize(Rg.Rows.Count)
.FillDown
.Value = .Value
.Sort Key1:=.Item(1, 1), order1:=xlAscending
End With
End With
End With

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub
'------------------------------------------------





MichD
---------------------------------------------------------------
"khinoa" a écrit dans le message de groupe de discussion :
5022983b$0$23532$426a74cc@news.free.fr...

Bonjour à tous,

Je voudrais comparer deux feuilles de 17 000 lignes environ et copier dans
une 3ème feuille les lignes de la feuille 2 dont le contenu de la cellule en
colonne A n'a pas été trouvée dans une autre cellule en colonne A de la
feuille 1. le
nombre de lignes évolue à la hausse chaque jour. Avec Excel 2010 il y a
certes 1 048 576 lignes mais peut-on vraiment les remplir toutes sans
risques de ralentissement notable ?

J'utilise déjà le code suivant qui fonctionne très bien sur des petits
nombres de lignes mais il est lent pour 17 000 lignes (environ 2 à 3
minutes).

Sub Comparaison()

Dim c As Range

On Error Resume Next

Application.ScreenUpdating = False
Sheets("BASE1").Activate

For Each c In Range("a2", Range("a1048576").End(3))
Sheets("BASE2").Activate
If Range("a2", Range("a1048576").End(3)).Find(c, Range("a2")) Is Nothing
Then
c.EntireRow.Copy Sheets("BASE3").Range("a1048576").End(3) (2)
End If
Next
End Sub

Je sais que l'on peut utiliser des tableaux en mémoire pour accélérer le
code. Mais les valeurs de la colonne A des deux feuilles à comparer
n'étant naturellement pas sur la même ligne, un code de type

Tblo1 = Sheets("BASE1").Range("a2:a1000000")
Tblo2 = Sheets("BASE2").Range("a2:a1000000")

Application.ScreenUpdating = False
For a = 1 To UBound(Tblo1, 1)
If Tblo1(a, 1) <> Tblo2(a,1) Then
Sheets("BASE3").Cells(a, 1) = Tblo1
End If
Next
Next

n'est d'aucune utilité tel quel car il compare deux cellules situées sur la
même ligne ce qui ne sera quasiment jamais le cas dans ma base de données.
Comment faire un mélange des deux codes, si c'est possible, pour avoir
l'exécution la plus rapide ?

D'avance merci à tous

khinoa

Pour la procédure utilisant le tableau, ceci devrait fonctionner !
Dans les feuilles, la ligne 1 est considérée comme une ligne d'étiquette de colonnes.

Recopie seulement les données de la feuil1 vers la feuil3

'--------------------------------------------------
Sub test()
Dim T As Variant, T1 As Variant
Dim G As Long, T2(), A As Long, Nb As Integer
Dim DerCol As Integer, DerLig As Long

With Feuil1
DerCol = .Cells.Find(What:="*", _
LookIn:=xlValues, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
DerLig = .Cells(.Rows.Count, 1).End(xlUp).Row
T = .Range(.Cells(2, 1), .Cells(DerLig, DerCol))
End With

With Feuil2
T1 = .Range("A2:A" & .Cells(.Rows.Count, 1).End(xlUp).Row)
End With

Application.EnableEvents = False
Application.ScreenUpdating = False
G = 1
Nb = UBound(T, 2)
For A = LBound(T, 1) To UBound(T, 1)
If Not IsNumeric(Application.Match(T(A, 1), T1, 0)) Then
Err.Clear
G = G + 1
Feuil3.Range("A" & G).Resize(, Nb).Value = _
Feuil1.Range("A" & A + 1).Resize(, Nb).Value
End If
Next
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
'--------------------------------------------------



MichD
---------------------------------------------------------------
"khinoa" a écrit dans le message de groupe de discussion :
5022be09$0$23539$426a74cc@news.free.fr...

Juste une précision. Dans mon code je récupérais le contenu de la ligne
(EntireRow) dont la valeur en colonne A de la feuille BASE2 était
introuvable en colonne A de la feuille BASE1. Ton code apparemment ne
renvoie que la valeur non trouvée de la colonne A. Est-il possible de
récupérer la totalité de la ligne ?

khinoa

"MichD" a écrit dans le message de groupe de discussion :
jvucu7$s6$1@speranza.aioe.org...

Petite correction :

Cette section de la procédure :
'------------------------
If Not IsNumeric(Application.Match(T(A, 1), T1, 0)) Then
G = G + 1
ReDim Preserve T2(1 To G)
T2(G) = T(A, 1)
Else
Err.Clear
End If
'------------------------

devrait être remplacé par :

'------------------------
If Not IsNumeric(Application.Match(T(A, 1), T1, 0)) Then
Err.Clear
G = G + 1
ReDim Preserve T2(1 To G)
T2(G) = T(A, 1)
End If
'------------------------


MichD
---------------------------------------------------------------

Celle-ci ne transfère que les valeurs de la colonne A de la feuil1 vers la feuil3.

As-tu des doublons dans la colonne A de la feuil1 ?



MichD
---------------------------------------------------------------

Non, en colonne A un numéro d'ordre donc pas de doublons.

Merci pour les codes et ton assistance.

khinoa

"MichD" a écrit dans le message de groupe de discussion :
jvuht8$cig$1@speranza.aioe.org...

Celle-ci ne transfère que les valeurs de la colonne A de la feuil1 vers la
feuil3.

As-tu des doublons dans la colonne A de la feuil1 ?



MichD
---------------------------------------------------------------

Bonjour,

J'ai testé tout tes codes, le plus rapide et de loin, comme tu le savais,
est celui-ci :

Sub test3()

Dim Rg As Range, Rg1 As Range

Sheets(3).Cells.ClearContents
'Quoique que dans l'immédiat Columns("a").ClearContents suffisait voire
Columns("a").Delete

With Sheets(2)
Set Rg = .Range("A2:A" & .Cells(.Rows.Count, 1).End(3).Row)
End With

With Sheets(1)
Set Rg1 = .Range("A2:A" & .Cells(.Rows.Count, 1).End(3).Row)
End With

Application.EnableEvents = False
Application.ScreenUpdating = False

With Sheets(3)
With .Range("A2")
.Formula = "=IF(COUNTIF(" & Rg1.Parent.Name & "!" & _
Rg1.Address & "," & Rg.Parent.Name & _
"!A2)=0," & Rg.Parent.Name & "!A2,"""")"
With .Resize(Rg.Rows.Count)
.FillDown
.Value = .Value
.Sort Key1:=.Item(1, 1), order1:=xlAscending
End With
End With
End With

Application.EnableEvents = True
Sheets(3).Select
End Sub


Par contre je ne comprenais pas comment fonctionnait le code et pourquoi il
était si rapide. En désactivant la partie With. Resize, j'ai vu la formule
inscrite en cellule A2.

=SI(NB.SI(Feuil1!$A$2:$A$17000;2!FeuilA2)=0;Feuil2!A2;""). J'en ai déduis le
fonctionnement du Parent. Name qui n'est sans doute pas obligatoire.

J'ai compris que le second With avec Resize et FillDown recopiait la formule
dans chaque cellule et affichait les valeurs manquantes à l'endroit où elles
manquent. Je pensais que l'utilisation d'une formule retardait le code, je
vois qu'il n'en est rien. Puis une recopie de la formule le nombre de lignes
nécessaire, .Value = .Value pour transformer la formule en son résultat et
un tri pour afficher le résultat en haut de la feuille. Je comprends un peu
mieux. Ai-je tout compris ? Les With sont-ils obligatoires ? Ne pourrait-on
pas écrire le code sans les With ? Le .Item pourrait-il être
vraisemblablement remplacé par Range("a2") ?

Le Parent. Name peut se remplacer par Rg1 tout court si
Set = Rg1 .Range("A2:A" & .Cells(.Rows.Count, 1).End(3).Row)
devient
Set = Sheets(1).Range("A2:A" & Sheets(1).Cells(.Rows.Count, 1).End(3).Row),
n'est-ce pas ?

En tout cas, merci déjà pour ton aide précieuse. Ce code a retrouvé 5
valeurs manquantes adjacentes en 6"40 (6 secondes) sur mon PC qui n'est pas
une bête de course, suffisant pour de la bureautique basique. J'ai été
époustouflé par la précision du code et sa rapidité. Ce sont des
instructions (Set, Resize, la formule) que je connaissais séparément mais je
ne pensais pas qu'en les combinant il était possible de parvenir à ce
résultat. En fait l'élément déterminant était l'usage de la formule. Encore
merci.


khinoa

PS : Ce matin j'ai travaillé sur un modèle vierge dans lequel avec une
boucle j'ai inséré en colonne A de la feuille 1 un numéro d'ordre jusqu'à
17000 puis copie de la colonne A en feuille 2, suppression de quelques
valeurs en feuille 1 et test.



"MichD" a écrit dans le message de groupe de discussion :
jvuht8$cig$1@speranza.aioe.org...

Celle-ci ne transfère que les valeurs de la colonne A de la feuil1 vers la
feuil3.

As-tu des doublons dans la colonne A de la feuil1 ?



MichD
---------------------------------------------------------------