Bonjour à toutes et à tous,
Je travaille sur Excel 2003. J'ai trouvé sur le forum la macro suivante :
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
Je l'ai copiée dans un classeur1.xls et créé le deuxième classeur et lorsque
j'exécute cette macro à partir du classer1.xls cela plante Excel (Excel ne
répond pas) Pouvez-vous me dire ce que j'ai raté ?
Merci pour votre aide
--
Pascale
Bonjour à toutes et à tous,
Je travaille sur Excel 2003. J'ai trouvé sur le forum la macro suivante :
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
Je l'ai copiée dans un classeur1.xls et créé le deuxième classeur et lorsque
j'exécute cette macro à partir du classer1.xls cela plante Excel (Excel ne
répond pas) Pouvez-vous me dire ce que j'ai raté ?
Merci pour votre aide
--
Pascale
Bonjour à toutes et à tous,
Je travaille sur Excel 2003. J'ai trouvé sur le forum la macro suivante :
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
Je l'ai copiée dans un classeur1.xls et créé le deuxième classeur et lorsque
j'exécute cette macro à partir du classer1.xls cela plante Excel (Excel ne
répond pas) Pouvez-vous me dire ce que j'ai raté ?
Merci pour votre aide
--
Pascale
Bonjour,
Ce code essaye d'ajouter 65536 objets dans Collection1, puis le même nombre
dans Collection2 (car il y a 65536 lignes dans un feuille Excel).
Cela rend la macro extrèmement lente et donne l'impression qu'Excel bloque.
(En appuyant sur Echap, il est possible d'arrêter l'exécution de la macro et
de récupérer la main).
D'après le code, vous essayer de comparer ligne par ligne les colonnes A des
deux feuilles. Le code suivant devrait fonctionner :
Sub Comparaison1()
Application.ScreenUpdating = False
Dim Time1 As Date, Time2 As Date
Time1 = Now()
Dim wb1 As Workbook
Dim wb2 As Workbook
Set wb1 = Workbooks("book2")
Set wb2 = Workbooks("book3")
' on ne veut pas comparer 65536 lignes
' en utilisant UsedRange, on se limite aux lignes utilisées
Dim maxRow1 As Integer
Dim maxRow2 As Integer
Dim maxRow As Integer
maxRow1 = wb1.ActiveSheet.UsedRange.Rows.Count
maxRow2 = wb2.ActiveSheet.UsedRange.Rows.Count
If maxRow1 > maxRow2 Then maxRow = maxRow1 Else maxRow = maxRow2
Dim i As Integer
For i = 1 To maxRow
If wb1.ActiveSheet.Cells(i, 1).Value <> wb2.ActiveSheet.Cells(i,
1).Value Then
' on change le fond en jaune, c'est plus visible, surtout pour
les cellules vides
wb1.ActiveSheet.Cells(i, 1).Interior.Color = vbYellow
End If
Next i
Time2 = Now()
Debug.Print "Test collection :" & Format$(Time2 - Time1, "hh:mm:ss")
Application.ScreenUpdating = True
End Sub
--
Pierre-Yves Rivaille
http://pyrexcel.wordpress.com
"VASNIER" wrote:
> Bonjour à toutes et à tous,
>
> Je travaille sur Excel 2003. J'ai trouvé sur le forum la macro suivante :
>
> 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
>
> Je l'ai copiée dans un classeur1.xls et créé le deuxième classeur et lorsque
> j'exécute cette macro à partir du classer1.xls cela plante Excel (Excel ne
> répond pas) Pouvez-vous me dire ce que j'ai raté ?
>
> Merci pour votre aide
>
> --
> Pascale
Bonjour,
Ce code essaye d'ajouter 65536 objets dans Collection1, puis le même nombre
dans Collection2 (car il y a 65536 lignes dans un feuille Excel).
Cela rend la macro extrèmement lente et donne l'impression qu'Excel bloque.
(En appuyant sur Echap, il est possible d'arrêter l'exécution de la macro et
de récupérer la main).
D'après le code, vous essayer de comparer ligne par ligne les colonnes A des
deux feuilles. Le code suivant devrait fonctionner :
Sub Comparaison1()
Application.ScreenUpdating = False
Dim Time1 As Date, Time2 As Date
Time1 = Now()
Dim wb1 As Workbook
Dim wb2 As Workbook
Set wb1 = Workbooks("book2")
Set wb2 = Workbooks("book3")
' on ne veut pas comparer 65536 lignes
' en utilisant UsedRange, on se limite aux lignes utilisées
Dim maxRow1 As Integer
Dim maxRow2 As Integer
Dim maxRow As Integer
maxRow1 = wb1.ActiveSheet.UsedRange.Rows.Count
maxRow2 = wb2.ActiveSheet.UsedRange.Rows.Count
If maxRow1 > maxRow2 Then maxRow = maxRow1 Else maxRow = maxRow2
Dim i As Integer
For i = 1 To maxRow
If wb1.ActiveSheet.Cells(i, 1).Value <> wb2.ActiveSheet.Cells(i,
1).Value Then
' on change le fond en jaune, c'est plus visible, surtout pour
les cellules vides
wb1.ActiveSheet.Cells(i, 1).Interior.Color = vbYellow
End If
Next i
Time2 = Now()
Debug.Print "Test collection :" & Format$(Time2 - Time1, "hh:mm:ss")
Application.ScreenUpdating = True
End Sub
--
Pierre-Yves Rivaille
http://pyrexcel.wordpress.com
"VASNIER" wrote:
> Bonjour à toutes et à tous,
>
> Je travaille sur Excel 2003. J'ai trouvé sur le forum la macro suivante :
>
> 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
>
> Je l'ai copiée dans un classeur1.xls et créé le deuxième classeur et lorsque
> j'exécute cette macro à partir du classer1.xls cela plante Excel (Excel ne
> répond pas) Pouvez-vous me dire ce que j'ai raté ?
>
> Merci pour votre aide
>
> --
> Pascale
Bonjour,
Ce code essaye d'ajouter 65536 objets dans Collection1, puis le même nombre
dans Collection2 (car il y a 65536 lignes dans un feuille Excel).
Cela rend la macro extrèmement lente et donne l'impression qu'Excel bloque.
(En appuyant sur Echap, il est possible d'arrêter l'exécution de la macro et
de récupérer la main).
D'après le code, vous essayer de comparer ligne par ligne les colonnes A des
deux feuilles. Le code suivant devrait fonctionner :
Sub Comparaison1()
Application.ScreenUpdating = False
Dim Time1 As Date, Time2 As Date
Time1 = Now()
Dim wb1 As Workbook
Dim wb2 As Workbook
Set wb1 = Workbooks("book2")
Set wb2 = Workbooks("book3")
' on ne veut pas comparer 65536 lignes
' en utilisant UsedRange, on se limite aux lignes utilisées
Dim maxRow1 As Integer
Dim maxRow2 As Integer
Dim maxRow As Integer
maxRow1 = wb1.ActiveSheet.UsedRange.Rows.Count
maxRow2 = wb2.ActiveSheet.UsedRange.Rows.Count
If maxRow1 > maxRow2 Then maxRow = maxRow1 Else maxRow = maxRow2
Dim i As Integer
For i = 1 To maxRow
If wb1.ActiveSheet.Cells(i, 1).Value <> wb2.ActiveSheet.Cells(i,
1).Value Then
' on change le fond en jaune, c'est plus visible, surtout pour
les cellules vides
wb1.ActiveSheet.Cells(i, 1).Interior.Color = vbYellow
End If
Next i
Time2 = Now()
Debug.Print "Test collection :" & Format$(Time2 - Time1, "hh:mm:ss")
Application.ScreenUpdating = True
End Sub
--
Pierre-Yves Rivaille
http://pyrexcel.wordpress.com
"VASNIER" wrote:
> Bonjour à toutes et à tous,
>
> Je travaille sur Excel 2003. J'ai trouvé sur le forum la macro suivante :
>
> 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
>
> Je l'ai copiée dans un classeur1.xls et créé le deuxième classeur et lorsque
> j'exécute cette macro à partir du classer1.xls cela plante Excel (Excel ne
> répond pas) Pouvez-vous me dire ce que j'ai raté ?
>
> Merci pour votre aide
>
> --
> Pascale
Merci beaucoup pour votre réponse,
J'ai essayé votre code. Lorsque je lance la macro seule la dernière ligne
vide de la colonne A du classeur1 est jaune. Je souhaiterais que les
références qui ne se trouvent pas dans la colonne A du claseur1 soient en
jaune et que les références qui se trouvent dans le classeur2 et pas dans le
classeur1 soient en jaune aussi.
Merci beaucoup
--
Pascale
"Pierre-Yves Rivaille" a écrit :
> Bonjour,
>
> Ce code essaye d'ajouter 65536 objets dans Collection1, puis le même nombre
> dans Collection2 (car il y a 65536 lignes dans un feuille Excel).
> Cela rend la macro extrèmement lente et donne l'impression qu'Excel bloque.
> (En appuyant sur Echap, il est possible d'arrêter l'exécution de la macro et
> de récupérer la main).
>
> D'après le code, vous essayer de comparer ligne par ligne les colonnes A des
> deux feuilles. Le code suivant devrait fonctionner :
>
> Sub Comparaison1()
> Application.ScreenUpdating = False
> Dim Time1 As Date, Time2 As Date
> Time1 = Now()
>
> Dim wb1 As Workbook
> Dim wb2 As Workbook
> Set wb1 = Workbooks("book2")
> Set wb2 = Workbooks("book3")
>
> ' on ne veut pas comparer 65536 lignes
> ' en utilisant UsedRange, on se limite aux lignes utilisées
> Dim maxRow1 As Integer
> Dim maxRow2 As Integer
> Dim maxRow As Integer
>
> maxRow1 = wb1.ActiveSheet.UsedRange.Rows.Count
> maxRow2 = wb2.ActiveSheet.UsedRange.Rows.Count
> If maxRow1 > maxRow2 Then maxRow = maxRow1 Else maxRow = maxRow2
>
>
> Dim i As Integer
> For i = 1 To maxRow
> If wb1.ActiveSheet.Cells(i, 1).Value <> wb2.ActiveSheet.Cells(i,
> 1).Value Then
> ' on change le fond en jaune, c'est plus visible, surtout pour
> les cellules vides
> wb1.ActiveSheet.Cells(i, 1).Interior.Color = vbYellow
> End If
> Next i
>
> Time2 = Now()
>
> Debug.Print "Test collection :" & Format$(Time2 - Time1, "hh:mm:ss")
> Application.ScreenUpdating = True
> End Sub
>
>
> --
> Pierre-Yves Rivaille
> http://pyrexcel.wordpress.com
>
>
> "VASNIER" wrote:
>
> > Bonjour à toutes et à tous,
> >
> > Je travaille sur Excel 2003. J'ai trouvé sur le forum la macro suivante :
> >
> > 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
> >
> > Je l'ai copiée dans un classeur1.xls et créé le deuxième classeur et lorsque
> > j'exécute cette macro à partir du classer1.xls cela plante Excel (Excel ne
> > répond pas) Pouvez-vous me dire ce que j'ai raté ?
> >
> > Merci pour votre aide
> >
> > --
> > Pascale
Merci beaucoup pour votre réponse,
J'ai essayé votre code. Lorsque je lance la macro seule la dernière ligne
vide de la colonne A du classeur1 est jaune. Je souhaiterais que les
références qui ne se trouvent pas dans la colonne A du claseur1 soient en
jaune et que les références qui se trouvent dans le classeur2 et pas dans le
classeur1 soient en jaune aussi.
Merci beaucoup
--
Pascale
"Pierre-Yves Rivaille" a écrit :
> Bonjour,
>
> Ce code essaye d'ajouter 65536 objets dans Collection1, puis le même nombre
> dans Collection2 (car il y a 65536 lignes dans un feuille Excel).
> Cela rend la macro extrèmement lente et donne l'impression qu'Excel bloque.
> (En appuyant sur Echap, il est possible d'arrêter l'exécution de la macro et
> de récupérer la main).
>
> D'après le code, vous essayer de comparer ligne par ligne les colonnes A des
> deux feuilles. Le code suivant devrait fonctionner :
>
> Sub Comparaison1()
> Application.ScreenUpdating = False
> Dim Time1 As Date, Time2 As Date
> Time1 = Now()
>
> Dim wb1 As Workbook
> Dim wb2 As Workbook
> Set wb1 = Workbooks("book2")
> Set wb2 = Workbooks("book3")
>
> ' on ne veut pas comparer 65536 lignes
> ' en utilisant UsedRange, on se limite aux lignes utilisées
> Dim maxRow1 As Integer
> Dim maxRow2 As Integer
> Dim maxRow As Integer
>
> maxRow1 = wb1.ActiveSheet.UsedRange.Rows.Count
> maxRow2 = wb2.ActiveSheet.UsedRange.Rows.Count
> If maxRow1 > maxRow2 Then maxRow = maxRow1 Else maxRow = maxRow2
>
>
> Dim i As Integer
> For i = 1 To maxRow
> If wb1.ActiveSheet.Cells(i, 1).Value <> wb2.ActiveSheet.Cells(i,
> 1).Value Then
> ' on change le fond en jaune, c'est plus visible, surtout pour
> les cellules vides
> wb1.ActiveSheet.Cells(i, 1).Interior.Color = vbYellow
> End If
> Next i
>
> Time2 = Now()
>
> Debug.Print "Test collection :" & Format$(Time2 - Time1, "hh:mm:ss")
> Application.ScreenUpdating = True
> End Sub
>
>
> --
> Pierre-Yves Rivaille
> http://pyrexcel.wordpress.com
>
>
> "VASNIER" wrote:
>
> > Bonjour à toutes et à tous,
> >
> > Je travaille sur Excel 2003. J'ai trouvé sur le forum la macro suivante :
> >
> > 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
> >
> > Je l'ai copiée dans un classeur1.xls et créé le deuxième classeur et lorsque
> > j'exécute cette macro à partir du classer1.xls cela plante Excel (Excel ne
> > répond pas) Pouvez-vous me dire ce que j'ai raté ?
> >
> > Merci pour votre aide
> >
> > --
> > Pascale
Merci beaucoup pour votre réponse,
J'ai essayé votre code. Lorsque je lance la macro seule la dernière ligne
vide de la colonne A du classeur1 est jaune. Je souhaiterais que les
références qui ne se trouvent pas dans la colonne A du claseur1 soient en
jaune et que les références qui se trouvent dans le classeur2 et pas dans le
classeur1 soient en jaune aussi.
Merci beaucoup
--
Pascale
"Pierre-Yves Rivaille" a écrit :
> Bonjour,
>
> Ce code essaye d'ajouter 65536 objets dans Collection1, puis le même nombre
> dans Collection2 (car il y a 65536 lignes dans un feuille Excel).
> Cela rend la macro extrèmement lente et donne l'impression qu'Excel bloque.
> (En appuyant sur Echap, il est possible d'arrêter l'exécution de la macro et
> de récupérer la main).
>
> D'après le code, vous essayer de comparer ligne par ligne les colonnes A des
> deux feuilles. Le code suivant devrait fonctionner :
>
> Sub Comparaison1()
> Application.ScreenUpdating = False
> Dim Time1 As Date, Time2 As Date
> Time1 = Now()
>
> Dim wb1 As Workbook
> Dim wb2 As Workbook
> Set wb1 = Workbooks("book2")
> Set wb2 = Workbooks("book3")
>
> ' on ne veut pas comparer 65536 lignes
> ' en utilisant UsedRange, on se limite aux lignes utilisées
> Dim maxRow1 As Integer
> Dim maxRow2 As Integer
> Dim maxRow As Integer
>
> maxRow1 = wb1.ActiveSheet.UsedRange.Rows.Count
> maxRow2 = wb2.ActiveSheet.UsedRange.Rows.Count
> If maxRow1 > maxRow2 Then maxRow = maxRow1 Else maxRow = maxRow2
>
>
> Dim i As Integer
> For i = 1 To maxRow
> If wb1.ActiveSheet.Cells(i, 1).Value <> wb2.ActiveSheet.Cells(i,
> 1).Value Then
> ' on change le fond en jaune, c'est plus visible, surtout pour
> les cellules vides
> wb1.ActiveSheet.Cells(i, 1).Interior.Color = vbYellow
> End If
> Next i
>
> Time2 = Now()
>
> Debug.Print "Test collection :" & Format$(Time2 - Time1, "hh:mm:ss")
> Application.ScreenUpdating = True
> End Sub
>
>
> --
> Pierre-Yves Rivaille
> http://pyrexcel.wordpress.com
>
>
> "VASNIER" wrote:
>
> > Bonjour à toutes et à tous,
> >
> > Je travaille sur Excel 2003. J'ai trouvé sur le forum la macro suivante :
> >
> > 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
> >
> > Je l'ai copiée dans un classeur1.xls et créé le deuxième classeur et lorsque
> > j'exécute cette macro à partir du classer1.xls cela plante Excel (Excel ne
> > répond pas) Pouvez-vous me dire ce que j'ai raté ?
> >
> > Merci pour votre aide
> >
> > --
> > Pascale
Je n'avais pas tout à fait compris ce que vous souhaitiez accomplir.
Le code suivant devrait mieux convenir à votre besoin :
Sub Comparaison1()
Application.ScreenUpdating = False
Dim Time1 As Date, Time2 As Date
Time1 = Now()
Dim wb1 As Workbook
Dim wb2 As Workbook
Set wb1 = Workbooks("book2")
Set wb2 = Workbooks("book3")
' on ne veut pas comparer 65536 lignes
' en utilisant UsedRange, on se limite aux lignes utilisées
Dim maxRow1 As Integer
Dim maxRow2 As Integer
Dim maxRow As Integer
maxRow1 = wb1.ActiveSheet.UsedRange.Rows.Count
maxRow2 = wb2.ActiveSheet.UsedRange.Rows.Count
If maxRow1 > maxRow2 Then maxRow = maxRow1 Else maxRow = maxRow2
Dim i As Integer
Dim j As Integer
For i = 1 To maxRow1
If wb1.ActiveSheet.Cells(i, 1).Value <> "" Then
For j = 1 To maxRow2
If wb1.ActiveSheet.Cells(i, 1).Value =
wb2.ActiveSheet.Cells(j, 1).Value Then
Exit For
End If
Next j
If j = maxRow2 + 1 Then wb1.ActiveSheet.Cells(i,
1).Interior.Color = vbYellow
End If
Next i
For j = 1 To maxRow2
If wb2.ActiveSheet.Cells(j, 1).Value <> "" Then
For i = 1 To maxRow1
If wb1.ActiveSheet.Cells(i, 1).Value =
wb2.ActiveSheet.Cells(j, 1).Value Then
Exit For
End If
Next i
If i = maxRow1 + 1 Then wb2.ActiveSheet.Cells(j,
1).Interior.Color = vbYellow
End If
Next j
Time2 = Now()
Debug.Print "Test collection :" & Format$(Time2 - Time1, "hh:mm:ss")
Application.ScreenUpdating = True
End Sub
Dites-moi si cela fonctionne.
--
Pierre-Yves Rivaille
http://pyrexcel.wordpress.com
"VASNIER" wrote:
> Merci beaucoup pour votre réponse,
>
> J'ai essayé votre code. Lorsque je lance la macro seule la dernière ligne
> vide de la colonne A du classeur1 est jaune. Je souhaiterais que les
> références qui ne se trouvent pas dans la colonne A du claseur1 soient en
> jaune et que les références qui se trouvent dans le classeur2 et pas dans le
> classeur1 soient en jaune aussi.
>
> Merci beaucoup
> --
> Pascale
>
>
> "Pierre-Yves Rivaille" a écrit :
>
> > Bonjour,
> >
> > Ce code essaye d'ajouter 65536 objets dans Collection1, puis le même nombre
> > dans Collection2 (car il y a 65536 lignes dans un feuille Excel).
> > Cela rend la macro extrèmement lente et donne l'impression qu'Excel bloque.
> > (En appuyant sur Echap, il est possible d'arrêter l'exécution de la macro et
> > de récupérer la main).
> >
> > D'après le code, vous essayer de comparer ligne par ligne les colonnes A des
> > deux feuilles. Le code suivant devrait fonctionner :
> >
> > Sub Comparaison1()
> > Application.ScreenUpdating = False
> > Dim Time1 As Date, Time2 As Date
> > Time1 = Now()
> >
> > Dim wb1 As Workbook
> > Dim wb2 As Workbook
> > Set wb1 = Workbooks("book2")
> > Set wb2 = Workbooks("book3")
> >
> > ' on ne veut pas comparer 65536 lignes
> > ' en utilisant UsedRange, on se limite aux lignes utilisées
> > Dim maxRow1 As Integer
> > Dim maxRow2 As Integer
> > Dim maxRow As Integer
> >
> > maxRow1 = wb1.ActiveSheet.UsedRange.Rows.Count
> > maxRow2 = wb2.ActiveSheet.UsedRange.Rows.Count
> > If maxRow1 > maxRow2 Then maxRow = maxRow1 Else maxRow = maxRow2
> >
> >
> > Dim i As Integer
> > For i = 1 To maxRow
> > If wb1.ActiveSheet.Cells(i, 1).Value <> wb2.ActiveSheet.Cells(i,
> > 1).Value Then
> > ' on change le fond en jaune, c'est plus visible, surtout pour
> > les cellules vides
> > wb1.ActiveSheet.Cells(i, 1).Interior.Color = vbYellow
> > End If
> > Next i
> >
> > Time2 = Now()
> >
> > Debug.Print "Test collection :" & Format$(Time2 - Time1, "hh:mm:ss")
> > Application.ScreenUpdating = True
> > End Sub
> >
> >
> > --
> > Pierre-Yves Rivaille
> > http://pyrexcel.wordpress.com
> >
> >
> > "VASNIER" wrote:
> >
> > > Bonjour à toutes et à tous,
> > >
> > > Je travaille sur Excel 2003. J'ai trouvé sur le forum la macro suivante :
> > >
> > > 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
> > >
> > > Je l'ai copiée dans un classeur1.xls et créé le deuxième classeur et lorsque
> > > j'exécute cette macro à partir du classer1.xls cela plante Excel (Excel ne
> > > répond pas) Pouvez-vous me dire ce que j'ai raté ?
> > >
> > > Merci pour votre aide
> > >
> > > --
> > > Pascale
Je n'avais pas tout à fait compris ce que vous souhaitiez accomplir.
Le code suivant devrait mieux convenir à votre besoin :
Sub Comparaison1()
Application.ScreenUpdating = False
Dim Time1 As Date, Time2 As Date
Time1 = Now()
Dim wb1 As Workbook
Dim wb2 As Workbook
Set wb1 = Workbooks("book2")
Set wb2 = Workbooks("book3")
' on ne veut pas comparer 65536 lignes
' en utilisant UsedRange, on se limite aux lignes utilisées
Dim maxRow1 As Integer
Dim maxRow2 As Integer
Dim maxRow As Integer
maxRow1 = wb1.ActiveSheet.UsedRange.Rows.Count
maxRow2 = wb2.ActiveSheet.UsedRange.Rows.Count
If maxRow1 > maxRow2 Then maxRow = maxRow1 Else maxRow = maxRow2
Dim i As Integer
Dim j As Integer
For i = 1 To maxRow1
If wb1.ActiveSheet.Cells(i, 1).Value <> "" Then
For j = 1 To maxRow2
If wb1.ActiveSheet.Cells(i, 1).Value =
wb2.ActiveSheet.Cells(j, 1).Value Then
Exit For
End If
Next j
If j = maxRow2 + 1 Then wb1.ActiveSheet.Cells(i,
1).Interior.Color = vbYellow
End If
Next i
For j = 1 To maxRow2
If wb2.ActiveSheet.Cells(j, 1).Value <> "" Then
For i = 1 To maxRow1
If wb1.ActiveSheet.Cells(i, 1).Value =
wb2.ActiveSheet.Cells(j, 1).Value Then
Exit For
End If
Next i
If i = maxRow1 + 1 Then wb2.ActiveSheet.Cells(j,
1).Interior.Color = vbYellow
End If
Next j
Time2 = Now()
Debug.Print "Test collection :" & Format$(Time2 - Time1, "hh:mm:ss")
Application.ScreenUpdating = True
End Sub
Dites-moi si cela fonctionne.
--
Pierre-Yves Rivaille
http://pyrexcel.wordpress.com
"VASNIER" wrote:
> Merci beaucoup pour votre réponse,
>
> J'ai essayé votre code. Lorsque je lance la macro seule la dernière ligne
> vide de la colonne A du classeur1 est jaune. Je souhaiterais que les
> références qui ne se trouvent pas dans la colonne A du claseur1 soient en
> jaune et que les références qui se trouvent dans le classeur2 et pas dans le
> classeur1 soient en jaune aussi.
>
> Merci beaucoup
> --
> Pascale
>
>
> "Pierre-Yves Rivaille" a écrit :
>
> > Bonjour,
> >
> > Ce code essaye d'ajouter 65536 objets dans Collection1, puis le même nombre
> > dans Collection2 (car il y a 65536 lignes dans un feuille Excel).
> > Cela rend la macro extrèmement lente et donne l'impression qu'Excel bloque.
> > (En appuyant sur Echap, il est possible d'arrêter l'exécution de la macro et
> > de récupérer la main).
> >
> > D'après le code, vous essayer de comparer ligne par ligne les colonnes A des
> > deux feuilles. Le code suivant devrait fonctionner :
> >
> > Sub Comparaison1()
> > Application.ScreenUpdating = False
> > Dim Time1 As Date, Time2 As Date
> > Time1 = Now()
> >
> > Dim wb1 As Workbook
> > Dim wb2 As Workbook
> > Set wb1 = Workbooks("book2")
> > Set wb2 = Workbooks("book3")
> >
> > ' on ne veut pas comparer 65536 lignes
> > ' en utilisant UsedRange, on se limite aux lignes utilisées
> > Dim maxRow1 As Integer
> > Dim maxRow2 As Integer
> > Dim maxRow As Integer
> >
> > maxRow1 = wb1.ActiveSheet.UsedRange.Rows.Count
> > maxRow2 = wb2.ActiveSheet.UsedRange.Rows.Count
> > If maxRow1 > maxRow2 Then maxRow = maxRow1 Else maxRow = maxRow2
> >
> >
> > Dim i As Integer
> > For i = 1 To maxRow
> > If wb1.ActiveSheet.Cells(i, 1).Value <> wb2.ActiveSheet.Cells(i,
> > 1).Value Then
> > ' on change le fond en jaune, c'est plus visible, surtout pour
> > les cellules vides
> > wb1.ActiveSheet.Cells(i, 1).Interior.Color = vbYellow
> > End If
> > Next i
> >
> > Time2 = Now()
> >
> > Debug.Print "Test collection :" & Format$(Time2 - Time1, "hh:mm:ss")
> > Application.ScreenUpdating = True
> > End Sub
> >
> >
> > --
> > Pierre-Yves Rivaille
> > http://pyrexcel.wordpress.com
> >
> >
> > "VASNIER" wrote:
> >
> > > Bonjour à toutes et à tous,
> > >
> > > Je travaille sur Excel 2003. J'ai trouvé sur le forum la macro suivante :
> > >
> > > 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
> > >
> > > Je l'ai copiée dans un classeur1.xls et créé le deuxième classeur et lorsque
> > > j'exécute cette macro à partir du classer1.xls cela plante Excel (Excel ne
> > > répond pas) Pouvez-vous me dire ce que j'ai raté ?
> > >
> > > Merci pour votre aide
> > >
> > > --
> > > Pascale
Je n'avais pas tout à fait compris ce que vous souhaitiez accomplir.
Le code suivant devrait mieux convenir à votre besoin :
Sub Comparaison1()
Application.ScreenUpdating = False
Dim Time1 As Date, Time2 As Date
Time1 = Now()
Dim wb1 As Workbook
Dim wb2 As Workbook
Set wb1 = Workbooks("book2")
Set wb2 = Workbooks("book3")
' on ne veut pas comparer 65536 lignes
' en utilisant UsedRange, on se limite aux lignes utilisées
Dim maxRow1 As Integer
Dim maxRow2 As Integer
Dim maxRow As Integer
maxRow1 = wb1.ActiveSheet.UsedRange.Rows.Count
maxRow2 = wb2.ActiveSheet.UsedRange.Rows.Count
If maxRow1 > maxRow2 Then maxRow = maxRow1 Else maxRow = maxRow2
Dim i As Integer
Dim j As Integer
For i = 1 To maxRow1
If wb1.ActiveSheet.Cells(i, 1).Value <> "" Then
For j = 1 To maxRow2
If wb1.ActiveSheet.Cells(i, 1).Value =
wb2.ActiveSheet.Cells(j, 1).Value Then
Exit For
End If
Next j
If j = maxRow2 + 1 Then wb1.ActiveSheet.Cells(i,
1).Interior.Color = vbYellow
End If
Next i
For j = 1 To maxRow2
If wb2.ActiveSheet.Cells(j, 1).Value <> "" Then
For i = 1 To maxRow1
If wb1.ActiveSheet.Cells(i, 1).Value =
wb2.ActiveSheet.Cells(j, 1).Value Then
Exit For
End If
Next i
If i = maxRow1 + 1 Then wb2.ActiveSheet.Cells(j,
1).Interior.Color = vbYellow
End If
Next j
Time2 = Now()
Debug.Print "Test collection :" & Format$(Time2 - Time1, "hh:mm:ss")
Application.ScreenUpdating = True
End Sub
Dites-moi si cela fonctionne.
--
Pierre-Yves Rivaille
http://pyrexcel.wordpress.com
"VASNIER" wrote:
> Merci beaucoup pour votre réponse,
>
> J'ai essayé votre code. Lorsque je lance la macro seule la dernière ligne
> vide de la colonne A du classeur1 est jaune. Je souhaiterais que les
> références qui ne se trouvent pas dans la colonne A du claseur1 soient en
> jaune et que les références qui se trouvent dans le classeur2 et pas dans le
> classeur1 soient en jaune aussi.
>
> Merci beaucoup
> --
> Pascale
>
>
> "Pierre-Yves Rivaille" a écrit :
>
> > Bonjour,
> >
> > Ce code essaye d'ajouter 65536 objets dans Collection1, puis le même nombre
> > dans Collection2 (car il y a 65536 lignes dans un feuille Excel).
> > Cela rend la macro extrèmement lente et donne l'impression qu'Excel bloque.
> > (En appuyant sur Echap, il est possible d'arrêter l'exécution de la macro et
> > de récupérer la main).
> >
> > D'après le code, vous essayer de comparer ligne par ligne les colonnes A des
> > deux feuilles. Le code suivant devrait fonctionner :
> >
> > Sub Comparaison1()
> > Application.ScreenUpdating = False
> > Dim Time1 As Date, Time2 As Date
> > Time1 = Now()
> >
> > Dim wb1 As Workbook
> > Dim wb2 As Workbook
> > Set wb1 = Workbooks("book2")
> > Set wb2 = Workbooks("book3")
> >
> > ' on ne veut pas comparer 65536 lignes
> > ' en utilisant UsedRange, on se limite aux lignes utilisées
> > Dim maxRow1 As Integer
> > Dim maxRow2 As Integer
> > Dim maxRow As Integer
> >
> > maxRow1 = wb1.ActiveSheet.UsedRange.Rows.Count
> > maxRow2 = wb2.ActiveSheet.UsedRange.Rows.Count
> > If maxRow1 > maxRow2 Then maxRow = maxRow1 Else maxRow = maxRow2
> >
> >
> > Dim i As Integer
> > For i = 1 To maxRow
> > If wb1.ActiveSheet.Cells(i, 1).Value <> wb2.ActiveSheet.Cells(i,
> > 1).Value Then
> > ' on change le fond en jaune, c'est plus visible, surtout pour
> > les cellules vides
> > wb1.ActiveSheet.Cells(i, 1).Interior.Color = vbYellow
> > End If
> > Next i
> >
> > Time2 = Now()
> >
> > Debug.Print "Test collection :" & Format$(Time2 - Time1, "hh:mm:ss")
> > Application.ScreenUpdating = True
> > End Sub
> >
> >
> > --
> > Pierre-Yves Rivaille
> > http://pyrexcel.wordpress.com
> >
> >
> > "VASNIER" wrote:
> >
> > > Bonjour à toutes et à tous,
> > >
> > > Je travaille sur Excel 2003. J'ai trouvé sur le forum la macro suivante :
> > >
> > > 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
> > >
> > > Je l'ai copiée dans un classeur1.xls et créé le deuxième classeur et lorsque
> > > j'exécute cette macro à partir du classer1.xls cela plante Excel (Excel ne
> > > répond pas) Pouvez-vous me dire ce que j'ai raté ?
> > >
> > > Merci pour votre aide
> > >
> > > --
> > > Pascale