Ameliorer un code qui tourne

[icecream33]

Bonjour à tous,

Voilà j'ai une macro qui compare deux fichiers excels (compare A1 du fichier 1 avec A1 du fichier 2 etc...) et j'ai plusieurs soucis:

-1)je voudrais que la macro compare toutes les feuilles du classeur les unes a la suite des autres car actuellement je dois la relancer autant de fois qu'il y de feuilles
2-)il faudrait que la macro puisse comparer les formules qu'il peut y avoir dans les cellules.
3-)cette macro ne fonctionne pas quand une cellule est vide cad que si B3 du fichier 1 est vide et que B3 du fichier 2 ne l'est pas, ça ne marche pas.

Donc si des ames charitables pouvaient y jeter un oeil ...

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

Workbooks("Classeur1.xls").Activate
For Each Cellule1 In Range("a1:k45")

Collection1.Add Cellule1
Next Cellule1

Workbooks("Classeur2.xls").Activate
For Each Cellule2 In Range("a1:k45")

collection2.Add Cellule2
Next Cellule2
For Each Element1 In Collection1
For Each Element2 In collection2
If Element1 <> Element2 Then
Element1.Font.Color = vbRed
Element1.Font.FontStyle = "gras"
Else
Element1.Font.Color = vbBlack
Exit For
End If
Next Element2
Next Element1

Application.ScreenUpdating = True
Workbooks("Classeur1.xls").Activate
End Sub

 

[Shock]

Re : Ameliorer un code qui tourne

bsalut icecream,
tu inclues ta boucle 'for each cellule1...next...' dans une boucle sur les feuilles :
for i = 1 to sheets.count
...
next i
ca marche sur les feuilles visibles, je sais pas sur les masquées...

 

[Kobaya]

Re : Ameliorer un code qui tourne

salut icecream33,

en combinant le code ci-dessous avec ce que t'a indiqué Shock, tu devrais avancer :

Sub Comparaison()
    Dim wbk1 As Workbook, wbk2 As Workbook
    Dim rngCell As Range
    Dim strAdresse As String
    
    Set wbk1 = Workbooks("Book2")
    Set wbk2 = Workbooks("Book3")
    
    ' a1:k45
    For Each rngCell In wbk1.Sheets("Sheet1").Range("A1:K45").Cells
        ' la propriété Fomula permet de tester la formule, si c'est une formule
        ' elle testera la valeur si la cellule ne contient pas de formule
        If rngCell.Formula <> wbk2.Sheets("Sheet1").Range(rngCell.Address).Formula Then
            rngCell.Interior.Color = vbBlue
        End If
    Next
    Set wbk1 = Nothing: Set wbk2 = Nothing
End Sub

 

[porcinet82]

Re : Ameliorer un code qui tourne

Salut icecream33, Shock, Kobaya,

Je voulais juste apporter un petit plus au code de Shock, ne pas oublier au début de la boucle de sélectionner la feuille sinon la boucle tournera sur la meme feuille.
for i = 1 to sheets.count
sheets(i).select
...
next i

Voili, voilou,

@+

 

[Papaye]

Re : Ameliorer un code qui tourne

Coucou Le forum,

Ma solution :

Sub Comparaison1()
Application.ScreenUpdating = False

For i = 1 To ActiveWorkbook.Sheets.Count
For j = 1 To 11
For k = 1 To 45
If Workbooks("Classeur1.xls").Sheets(i).Cells(j, k) <> Workbooks("Classeur2.xls").Sheets(i).Cells(j, k) Then
Workbooks("Classeur1.xls").Sheets(i).Cells(j, k).Font.Color = vbRed
Workbooks("Classeur1.xls").Sheets(i).Cells(j, k).Font.Bold = True
Else
Workbooks("Classeur1.xls").Sheets(i).Cells(j, k).Font.Color = vbGreen
End If

If Workbooks("Classeur1.xls").Sheets(i).Cells(j, k).Formula <> Workbooks("Classeur2.xls").Sheets(i).Cells(j, k).Formula Then
Workbooks("Classeur1.xls").Sheets(i).Cells(j, k).Font.Italic = True
Else
Workbooks("Classeur1.xls").Sheets(i).Cells(j, k).Font.Italic = False
End If
Next k
Next j
Next i
Application.ScreenUpdating = True
End Sub

Papaye