macro comparaison fichier ne fonctionne pas

Bonjour à toutes et à tous,

Je vais très souvent sur le fabuleux site d'Excelabo. J'ai trouvé les
macros ci-dessous et ai essayé de les utiliser pour mes deux fichiers à
comparer. Lorsque je les lance j'ai un sablier et le message suivant
Microsoft Excel (ne répond pas). voici les macros, je ne vois pas où est
le
problème. merci à vous

Sub Comparaison1()
Application.ScreenUpdating = False
Dim Collection1 As New Collection, collection2 As New Collection
Dim Cellule1 As Range, Cellule2 As Range
Dim Element1 As Object, Element2 As Object
Dim Time1 As Date, Time2 As Date
Time1 = Now()

Workbooks("classeur1.xls").Activate
For Each Cellule1 In Range("a:a")

Collection1.Add Cellule1
Next Cellule1

Workbooks("classeur2.xls").Activate
For Each Cellule2 In Range("a:a")

collection2.Add Cellule2
Next Cellule2
For Each Element1 In Collection1
For Each Element2 In collection2
If Element1 <> Element2 Then
Element1.Font.Color = vbRed
Else
Element1.Font.Color = vbBlack
Exit For
End If
Next Element2
Next Element1
Time2 = Now()

Debug.Print "Test collection :" & Format$(Time2 - Time1, "hh:mm:ss")
Application.ScreenUpdating = True
End Sub



Sub Comparaison()
Application.ScreenUpdating = False
Dim Cellule1 As Range, Cellule2 As Range
Dim Time1 As Date, Time2 As Date
Time1 = Now()
Workbooks("classeur1.xls").Activate
For Each Cellule1 In Range("liste1")
Workbooks("classeur2.xls").Activate
For Each Cellule2 In Range("liste2")
If Cellule1 <> Cellule2 Then
Cellule1.Font.Color = vbRed
Else
Cellule1.Font.Color = vbBlack
Exit For
End If
Next Cellule2
Workbooks("classeur1.xls").Activate
Next Cellule1
Time2 = Now()
Debug.Print "TestListe :" & Format$(Time2 -
Time1, "hh:mm:ss")
Application.ScreenUpdating = True
End Sub


--
Pascale

Les classeurs sont ils gros ?
Quelle macro plante ? Les deux ?
Tes classeurs s'appellent bien classeur1.xls et classeur2.xls ?
Essaie en enlevant cette ligne, tu verras peut être ce qui se passe
d'anormal sinon execute en pas à pas en allant dans le code vba puis en
appuyant sur F8
Application.ScreenUpdating = False


"VASNIER" <pvasnier83@free.fr.(sansspam)> a écrit dans le message de
news:4CCF553B-1A31-437A-9CE9-08389D198229@microsoft.com...

Bonjour à toutes et à tous,

Je vais très souvent sur le fabuleux site d'Excelabo. J'ai trouvé les
macros ci-dessous et ai essayé de les utiliser pour mes deux fichiers à
comparer. Lorsque je les lance j'ai un sablier et le message suivant
Microsoft Excel (ne répond pas). voici les macros, je ne vois pas où est
le
problème. merci à vous

Sub Comparaison1()
Application.ScreenUpdating = False
Dim Collection1 As New Collection, collection2 As New Collection
Dim Cellule1 As Range, Cellule2 As Range
Dim Element1 As Object, Element2 As Object
Dim Time1 As Date, Time2 As Date
Time1 = Now()

Workbooks("classeur1.xls").Activate
For Each Cellule1 In Range("a:a")

Collection1.Add Cellule1
Next Cellule1

Workbooks("classeur2.xls").Activate
For Each Cellule2 In Range("a:a")

collection2.Add Cellule2
Next Cellule2
For Each Element1 In Collection1
For Each Element2 In collection2
If Element1 <> Element2 Then
Element1.Font.Color = vbRed
Else
Element1.Font.Color = vbBlack
Exit For
End If
Next Element2
Next Element1
Time2 = Now()

Debug.Print "Test collection :" & Format$(Time2 - Time1, "hh:mm:ss")
Application.ScreenUpdating = True
End Sub



Sub Comparaison()
Application.ScreenUpdating = False
Dim Cellule1 As Range, Cellule2 As Range
Dim Time1 As Date, Time2 As Date
Time1 = Now()
Workbooks("classeur1.xls").Activate
For Each Cellule1 In Range("liste1")
Workbooks("classeur2.xls").Activate
For Each Cellule2 In Range("liste2")
If Cellule1 <> Cellule2 Then
Cellule1.Font.Color = vbRed
Else
Cellule1.Font.Color = vbBlack
Exit For
End If
Next Cellule2
Workbooks("classeur1.xls").Activate
Next Cellule1
Time2 = Now()
Debug.Print "TestListe :" & Format$(Time2 -
Time1, "hh:mm:ss")
Application.ScreenUpdating = True
End Sub


--
Pascale

--
Michel Angelosanto, Bordeaux
http://angelosa.free.fr/

Bonjour à toutes et à tous,

Je vais très souvent sur le fabuleux site d'Excelabo. J'ai trouvé les  
macros ci-dessous et ai essayé de les utiliser pour mes deux fichiers à
comparer. Lorsque je les lance j'ai un sablier et le message suivant
Microsoft Excel (ne répond pas). voici les macros, je ne vois pas où e st le
problème. merci à vous

Sub Comparaison1()
Application.ScreenUpdating = False
Dim Collection1 As New Collection, collection2 As New Collection
Dim Cellule1 As Range, Cellule2 As Range
Dim Element1 As Object, Element2 As Object
Dim Time1 As Date, Time2 As Date
Time1 = Now()

Workbooks("classeur1.xls").Activate
For Each Cellule1 In Range("a:a")

Collection1.Add Cellule1
Next Cellule1

Workbooks("classeur2.xls").Activate
For Each Cellule2 In Range("a:a")

collection2.Add Cellule2
Next Cellule2
For Each Element1 In Collection1
For Each Element2 In collection2
If Element1 <> Element2 Then
Element1.Font.Color = vbRed
Else
Element1.Font.Color = vbBlack
Exit For
End If
Next Element2
Next Element1
Time2 = Now()

Debug.Print "Test collection :" & Format$(Time2 - Time1, "hh:mm:ss")
Application.ScreenUpdating = True
End Sub

Sub Comparaison()
Application.ScreenUpdating = False
Dim Cellule1 As Range, Cellule2 As Range
Dim Time1 As Date, Time2 As Date
Time1 = Now()
Workbooks("classeur1.xls").Activate
For Each Cellule1 In Range("liste1")
Workbooks("classeur2.xls").Activate
For Each Cellule2 In Range("liste2")
If Cellule1 <> Cellule2 Then
Cellule1.Font.Color = vbRed
Else
Cellule1.Font.Color = vbBlack
Exit For
End If
Next Cellule2
Workbooks("classeur1.xls").Activate
Next Cellule1
Time2 = Now()
Debug.Print "TestListe :" & Format$(Time2 -
Time1, "hh:mm:ss")
Application.ScreenUpdating = True
End Sub

--
Pascale

Bonsoir,

Sub ComparaisonColonne()
t = Timer()
f = 1 'no feuille
Application.ScreenUpdating = False
Set MonDico1 = CreateObject("Scripting.Dictionary")
Set MonDico2 = CreateObject("Scripting.Dictionary")
Workbooks("classeur1.xls").Activate
For Each c In
Sheets(f).Range("A:D").SpecialCells(xlCellTypeConstants, 23)
If Not MonDico1.Exists(c.Value) Then MonDico1.Add c.Value,
c.Address
Next
Workbooks("classeur2.xls").Activate
Sheets(f).Activate
For Each c In
Sheets(f).Range("A:D").SpecialCells(xlCellTypeConstants, 23)
If Not MonDico2.Exists(c.Value) Then MonDico2.Add c.Value,
c.Address
Next

Workbooks("classeur1.xls").Activate
Sheets(f).Activate
For Each e In MonDico1
If Not MonDico2.Exists(e) Then
Range(MonDico1.Item(e)).Font.Color = vbRed
Else
Range(MonDico1.Item(e)).Font.Color = vbBlack
End If
Next
Application.ScreenUpdating = True
MsgBox Timer() - t
End Sub

http://cjoint.com/?dEtxJVKHKZ

JB
http://boisgontierjacques.free.fr/


On 30 mar, 15:36, VASNIER <pvasnie...@free.fr.(sansspam)> wrote:

Bonjour à toutes et à tous,

Je vais très souvent sur le fabuleux site d'Excelabo. J'ai trouvé les
macros ci-dessous et ai essayé de les utiliser pour mes deux fichiers à
comparer. Lorsque je les lance j'ai un sablier et le message suivant
Microsoft Excel (ne répond pas). voici les macros, je ne vois pas où est le
problème. merci à vous

Sub Comparaison1()
Application.ScreenUpdating = False
Dim Collection1 As New Collection, collection2 As New Collection
Dim Cellule1 As Range, Cellule2 As Range
Dim Element1 As Object, Element2 As Object
Dim Time1 As Date, Time2 As Date
Time1 = Now()

Workbooks("classeur1.xls").Activate
For Each Cellule1 In Range("a:a")

Collection1.Add Cellule1
Next Cellule1

Workbooks("classeur2.xls").Activate
For Each Cellule2 In Range("a:a")

collection2.Add Cellule2
Next Cellule2
For Each Element1 In Collection1
For Each Element2 In collection2
If Element1 <> Element2 Then
Element1.Font.Color = vbRed
Else
Element1.Font.Color = vbBlack
Exit For
End If
Next Element2
Next Element1
Time2 = Now()

Debug.Print "Test collection :" & Format$(Time2 - Time1, "hh:mm:ss")
Application.ScreenUpdating = True
End Sub

Sub Comparaison()
Application.ScreenUpdating = False
Dim Cellule1 As Range, Cellule2 As Range
Dim Time1 As Date, Time2 As Date
Time1 = Now()
Workbooks("classeur1.xls").Activate
For Each Cellule1 In Range("liste1")
Workbooks("classeur2.xls").Activate
For Each Cellule2 In Range("liste2")
If Cellule1 <> Cellule2 Then
Cellule1.Font.Color = vbRed
Else
Cellule1.Font.Color = vbBlack
Exit For
End If
Next Cellule2
Workbooks("classeur1.xls").Activate
Next Cellule1
Time2 = Now()
Debug.Print "TestListe :" & Format$(Time2 -
Time1, "hh:mm:ss")
Application.ScreenUpdating = True
End Sub

--
Pascale

Bonjour à toutes et à tous,

Je vais très souvent sur le fabuleux site d'Excelabo. J'ai trouvé les
macros ci-dessous et ai essayé de les utiliser pour mes deux fichiers à
comparer. Lorsque je les lance j'ai un sablier et le message suivant
Microsoft Excel (ne répond pas). voici les macros, je ne vois pas où est
le
problème. merci à vous

Sub Comparaison1()
Application.ScreenUpdating = False
Dim Collection1 As New Collection, collection2 As New Collection
Dim Cellule1 As Range, Cellule2 As Range
Dim Element1 As Object, Element2 As Object
Dim Time1 As Date, Time2 As Date
Time1 = Now()

Workbooks("classeur1.xls").Activate
For Each Cellule1 In Range("a:a")

Collection1.Add Cellule1
Next Cellule1

Workbooks("classeur2.xls").Activate
For Each Cellule2 In Range("a:a")

collection2.Add Cellule2
Next Cellule2
For Each Element1 In Collection1
For Each Element2 In collection2
If Element1 <> Element2 Then
Element1.Font.Color = vbRed
Else
Element1.Font.Color = vbBlack
Exit For
End If
Next Element2
Next Element1
Time2 = Now()

Debug.Print "Test collection :" & Format$(Time2 - Time1, "hh:mm:ss")
Application.ScreenUpdating = True
End Sub



Sub Comparaison()
Application.ScreenUpdating = False
Dim Cellule1 As Range, Cellule2 As Range
Dim Time1 As Date, Time2 As Date
Time1 = Now()
Workbooks("classeur1.xls").Activate
For Each Cellule1 In Range("liste1")
Workbooks("classeur2.xls").Activate
For Each Cellule2 In Range("liste2")
If Cellule1 <> Cellule2 Then
Cellule1.Font.Color = vbRed
Else
Cellule1.Font.Color = vbBlack
Exit For
End If
Next Cellule2
Workbooks("classeur1.xls").Activate
Next Cellule1
Time2 = Now()
Debug.Print "TestListe :" & Format$(Time2 -
Time1, "hh:mm:ss")
Application.ScreenUpdating = True
End Sub


--
Pascale

Sub BpplusRap()
Dim c As Object, t
Dim plg1 As Range, Plg2 As Range
Application.ScreenUpdating = False
t = Timer()
'Workbooks("classeur1.xls").Activate
Set plg1 = Workbooks("Classeur1.xls").Sheets("Feuil1").Range("A1:A100")
'Workbooks("classeur2.xls").Activate
Set Plg2 = Workbooks("Classeur2.xls").Sheets("Feuil1").Range("A1:A100")
For Each c In plg1
If Plg2.Find(c) Is Nothing Then
c.Font.Bold = True
Else
c.Font.Bold = False
End If
Next
MsgBox Timer() - t
Application.ScreenUpdating = True
End Sub
--
ponsinet.frederic363etdesbrouet...@orange.fr
Sans les bérouettes
"VASNIER" <pvasnie...@free.fr.(sansspam)> a écrit dans le message de new s:
4CCF553B-1A31-437A-9CE9-08389D198...@microsoft.com...

Bonjour à toutes et à tous,

Je vais très souvent sur le fabuleux site d'Excelabo. J'ai trouvé le s
macros ci-dessous et ai essayé de les utiliser pour mes deux fichiers à
comparer. Lorsque je les lance j'ai un sablier et le message suivant
Microsoft Excel (ne répond pas). voici les macros, je ne vois pas où est
le
problème. merci à vous

Sub Comparaison1()
Application.ScreenUpdating = False
Dim Collection1 As New Collection, collection2 As New Collection
Dim Cellule1 As Range, Cellule2 As Range
Dim Element1 As Object, Element2 As Object
Dim Time1 As Date, Time2 As Date
Time1 = Now()

Workbooks("classeur1.xls").Activate
For Each Cellule1 In Range("a:a")

Collection1.Add Cellule1
Next Cellule1

Workbooks("classeur2.xls").Activate
For Each Cellule2 In Range("a:a")

collection2.Add Cellule2
Next Cellule2
For Each Element1 In Collection1
For Each Element2 In collection2
If Element1 <> Element2 Then
Element1.Font.Color = vbRed
Else
Element1.Font.Color = vbBlack
Exit For
End If
Next Element2
Next Element1
Time2 = Now()

Debug.Print "Test collection :" & Format$(Time2 - Time1, "hh:mm:ss")
Application.ScreenUpdating = True
End Sub

Sub Comparaison()
Application.ScreenUpdating = False
Dim Cellule1 As Range, Cellule2 As Range
Dim Time1 As Date, Time2 As Date
Time1 = Now()
Workbooks("classeur1.xls").Activate
For Each Cellule1 In Range("liste1")
Workbooks("classeur2.xls").Activate
For Each Cellule2 In Range("liste2")
If Cellule1 <> Cellule2 Then
Cellule1.Font.Color = vbRed
Else
Cellule1.Font.Color = vbBlack
Exit For
End If
Next Cellule2
Workbooks("classeur1.xls").Activate
Next Cellule1
Time2 = Now()
Debug.Print "TestListe :" & Format$(Time2 -
Time1, "hh:mm:ss")
Application.ScreenUpdating = True
End Sub

--
Pascale- Masquer le texte des messages précédents -

- Afficher le texte des messages précédents -

Sub BpplusRap()
Dim c As Object, t
Dim plg1 As Range, Plg2 As Range
Application.ScreenUpdating = False
t = Timer()
'Workbooks("classeur1.xls").Activate
Set plg1 = Workbooks("Classeur1.xls").Sheets("Feuil1").Range("A1:A100")
'Workbooks("classeur2.xls").Activate
Set Plg2 = Workbooks("Classeur2.xls").Sheets("Feuil1").Range("A1:A100")
For Each c In plg1
If Plg2.Find(c) Is Nothing Then
c.Font.Bold = True
Else
c.Font.Bold = False
End If
Next
MsgBox Timer() - t
Application.ScreenUpdating = True
End Sub
--
ponsinet.frederic363etdesbrouet...@orange.fr
Sans les bérouettes
"VASNIER" <pvasnie...@free.fr.(sansspam)> a écrit dans le message de news:
4CCF553B-1A31-437A-9CE9-08389D198...@microsoft.com...

Bonjour à toutes et à tous,

Je vais très souvent sur le fabuleux site d'Excelabo. J'ai trouvé les
macros ci-dessous et ai essayé de les utiliser pour mes deux fichiers à
comparer. Lorsque je les lance j'ai un sablier et le message suivant
Microsoft Excel (ne répond pas). voici les macros, je ne vois pas où est
le
problème. merci à vous

Sub Comparaison1()
Application.ScreenUpdating = False
Dim Collection1 As New Collection, collection2 As New Collection
Dim Cellule1 As Range, Cellule2 As Range
Dim Element1 As Object, Element2 As Object
Dim Time1 As Date, Time2 As Date
Time1 = Now()

Workbooks("classeur1.xls").Activate
For Each Cellule1 In Range("a:a")

Collection1.Add Cellule1
Next Cellule1

Workbooks("classeur2.xls").Activate
For Each Cellule2 In Range("a:a")

collection2.Add Cellule2
Next Cellule2
For Each Element1 In Collection1
For Each Element2 In collection2
If Element1 <> Element2 Then
Element1.Font.Color = vbRed
Else
Element1.Font.Color = vbBlack
Exit For
End If
Next Element2
Next Element1
Time2 = Now()

Debug.Print "Test collection :" & Format$(Time2 - Time1, "hh:mm:ss")
Application.ScreenUpdating = True
End Sub

Sub Comparaison()
Application.ScreenUpdating = False
Dim Cellule1 As Range, Cellule2 As Range
Dim Time1 As Date, Time2 As Date
Time1 = Now()
Workbooks("classeur1.xls").Activate
For Each Cellule1 In Range("liste1")
Workbooks("classeur2.xls").Activate
For Each Cellule2 In Range("liste2")
If Cellule1 <> Cellule2 Then
Cellule1.Font.Color = vbRed
Else
Cellule1.Font.Color = vbBlack
Exit For
End If
Next Cellule2
Workbooks("classeur1.xls").Activate
Next Cellule1
Time2 = Now()
Debug.Print "TestListe :" & Format$(Time2 -
Time1, "hh:mm:ss")
Application.ScreenUpdating = True
End Sub

--
Pascale- Masquer le texte des messages précédents -

- Afficher le texte des messages précédents -

Sub BpplusRap()
Dim c As Object, t
Dim plg1 As Range, Plg2 As Range
Application.ScreenUpdating = False
t = Timer()
'Workbooks("classeur1.xls").Activate
Set plg1 = Workbooks("Classeur1.xls").Sheets("Feuil1").Range("A1:A100")
'Workbooks("classeur2.xls").Activate
Set Plg2 = Workbooks("Classeur2.xls").Sheets("Feuil1").Range("A1:A100")
For Each c In plg1
If Plg2.Find(c) Is Nothing Then
c.Font.Bold = True
Else
c.Font.Bold = False
End If
Next
MsgBox Timer() - t
Application.ScreenUpdating = True
End Sub
--
ponsinet.frederic363etdesbrouet...@orange.fr
Sans les bérouettes
"VASNIER" <pvasnie...@free.fr.(sansspam)> a écrit dans le message de news:
4CCF553B-1A31-437A-9CE9-08389D198...@microsoft.com...

Bonjour à toutes et à tous,

Je vais très souvent sur le fabuleux site d'Excelabo. J'ai trouvé les
macros ci-dessous et ai essayé de les utiliser pour mes deux fichiers à
comparer. Lorsque je les lance j'ai un sablier et le message suivant
Microsoft Excel (ne répond pas). voici les macros, je ne vois pas où est
le
problème. merci à vous

Sub Comparaison1()
Application.ScreenUpdating = False
Dim Collection1 As New Collection, collection2 As New Collection
Dim Cellule1 As Range, Cellule2 As Range
Dim Element1 As Object, Element2 As Object
Dim Time1 As Date, Time2 As Date
Time1 = Now()

Workbooks("classeur1.xls").Activate
For Each Cellule1 In Range("a:a")

Collection1.Add Cellule1
Next Cellule1

Workbooks("classeur2.xls").Activate
For Each Cellule2 In Range("a:a")

collection2.Add Cellule2
Next Cellule2
For Each Element1 In Collection1
For Each Element2 In collection2
If Element1 <> Element2 Then
Element1.Font.Color = vbRed
Else
Element1.Font.Color = vbBlack
Exit For
End If
Next Element2
Next Element1
Time2 = Now()

Debug.Print "Test collection :" & Format$(Time2 - Time1, "hh:mm:ss")
Application.ScreenUpdating = True
End Sub

Sub Comparaison()
Application.ScreenUpdating = False
Dim Cellule1 As Range, Cellule2 As Range
Dim Time1 As Date, Time2 As Date
Time1 = Now()
Workbooks("classeur1.xls").Activate
For Each Cellule1 In Range("liste1")
Workbooks("classeur2.xls").Activate
For Each Cellule2 In Range("liste2")
If Cellule1 <> Cellule2 Then
Cellule1.Font.Color = vbRed
Else
Cellule1.Font.Color = vbBlack
Exit For
End If
Next Cellule2
Workbooks("classeur1.xls").Activate
Next Cellule1
Time2 = Now()
Debug.Print "TestListe :" & Format$(Time2 -
Time1, "hh:mm:ss")
Application.ScreenUpdating = True
End Sub

--
Pascale- Masquer le texte des messages précédents -

- Afficher le texte des messages précédents -

Sur XL2007 ComparaisonChamp est dans tous les cas + rapide--


ponsinet.frederic363etdesbrouettes@orange.fr
Sans les bérouettes
"JB" <boisgontier@hotmail.com> a écrit dans le message de news:
d8608225-a0c5-4793-9051-cd0415ce0f66@b1g2000hsg.googlegroups.com...
Bonjour,

Pour 10.000 éléments 2,3s au lieu de 17,5 s

Sub ComparaisonChamp()
t = Timer()
Application.ScreenUpdating = False
Set MonDico1 = CreateObject("Scripting.Dictionary")
Set MonDico2 = CreateObject("Scripting.Dictionary")
Workbooks("classeur1.xls").Activate
For Each c In
Sheets(1).Range("A1:B5000").SpecialCells(xlCellTypeConstants, 23)
If Not MonDico1.Exists(c.Value) Then MonDico1.Add c.Value,
c.Address
Next
Workbooks("classeur2.xls").Activate
For Each c In Sheets(1).Range("A1:B5000")
If Not MonDico2.Exists(c) Then MonDico2.Add c.Value, c.Address
Next
Workbooks("classeur1.xls").Activate
For Each e In MonDico1
Range(MonDico1.Item(e)).Font.Color = IIf(MonDico2.Exists(e),
vblack, vbRed)
Next
MsgBox Timer() - t
End Sub

JB

On 31 mar, 00:11, "Fredo P."
<ponsinet.frederic363etdesbrouet...@orange.fr> wrote:

Sub BpplusRap()
Dim c As Object, t
Dim plg1 As Range, Plg2 As Range
Application.ScreenUpdating = False
t = Timer()
'Workbooks("classeur1.xls").Activate
Set plg1 = Workbooks("Classeur1.xls").Sheets("Feuil1").Range("A1:A100")
'Workbooks("classeur2.xls").Activate
Set Plg2 = Workbooks("Classeur2.xls").Sheets("Feuil1").Range("A1:A100")
For Each c In plg1
If Plg2.Find(c) Is Nothing Then
c.Font.Bold = True
Else
c.Font.Bold = False
End If
Next
MsgBox Timer() - t
Application.ScreenUpdating = True
End Sub
--
ponsinet.frederic363etdesbrouet...@orange.fr
Sans les bérouettes
"VASNIER" <pvasnie...@free.fr.(sansspam)> a écrit dans le message de news:
4CCF553B-1A31-437A-9CE9-08389D198...@microsoft.com...

Bonjour à toutes et à tous,

Je vais très souvent sur le fabuleux site d'Excelabo. J'ai trouvé les
macros ci-dessous et ai essayé de les utiliser pour mes deux fichiers à
comparer. Lorsque je les lance j'ai un sablier et le message suivant
Microsoft Excel (ne répond pas). voici les macros, je ne vois pas où est
le
problème. merci à vous

Sub Comparaison1()
Application.ScreenUpdating = False
Dim Collection1 As New Collection, collection2 As New Collection
Dim Cellule1 As Range, Cellule2 As Range
Dim Element1 As Object, Element2 As Object
Dim Time1 As Date, Time2 As Date
Time1 = Now()

Workbooks("classeur1.xls").Activate
For Each Cellule1 In Range("a:a")

Collection1.Add Cellule1
Next Cellule1

Workbooks("classeur2.xls").Activate
For Each Cellule2 In Range("a:a")

collection2.Add Cellule2
Next Cellule2
For Each Element1 In Collection1
For Each Element2 In collection2
If Element1 <> Element2 Then
Element1.Font.Color = vbRed
Else
Element1.Font.Color = vbBlack
Exit For
End If
Next Element2
Next Element1
Time2 = Now()

Debug.Print "Test collection :" & Format$(Time2 - Time1, "hh:mm:ss")
Application.ScreenUpdating = True
End Sub

Sub Comparaison()
Application.ScreenUpdating = False
Dim Cellule1 As Range, Cellule2 As Range
Dim Time1 As Date, Time2 As Date
Time1 = Now()
Workbooks("classeur1.xls").Activate
For Each Cellule1 In Range("liste1")
Workbooks("classeur2.xls").Activate
For Each Cellule2 In Range("liste2")
If Cellule1 <> Cellule2 Then
Cellule1.Font.Color = vbRed
Else
Cellule1.Font.Color = vbBlack
Exit For
End If
Next Cellule2
Workbooks("classeur1.xls").Activate
Next Cellule1
Time2 = Now()
Debug.Print "TestListe :" & Format$(Time2 -
Time1, "hh:mm:ss")
Application.ScreenUpdating = True
End Sub

--
Pascale- Masquer le texte des messages précédents -

- Afficher le texte des messages précédents -