Comparaison de cellules boucles For

Bonjour à tous,

Je vous écris car j'ai une macro qui fonctionne mais s'exécute en un peu plus de 30 min.

L'idée de base est simple, j'ai un fichier excel 1 et un fichier excel 2 que j'ouvre avec un userform présent dans un fichier excel 3. Je compare des cellules d'un tableau du fichier excel 1 au tableau du fichier excel 2 et j'inscris toutes les valeurs comparer et les différences dans un tableau présent dans le fichier excel 3.

Le problème c'est que la macro est atrocement longue car j'ai 25000 lignes dans le premier fichier et 3000 dans le deuxième.

J'aimerais trouver une autre méthode plus rapide ou optimiser ma macro quelqu'un aurait il une idée ?

Je vous joins tous les fichiers mais je vous ai laissé que 2 lignes par fichier

Ma macro est dans le fichier nommé "Vérif_DWR".

15verif-dwr.xlsm (150.35 Ko)

Peut être inclure la boucle "coloriage" dans les boucles de transfert de données

feuil1 = tw.Worksheets("Feuil1")

For i = 2 To derligPin_vr

For j = 1 To derligPinC_mpa

'If wb_vr.Worksheets("Results").Cells(i, idx_pin_vr).Value <> "" Then

If wb_vr.Worksheets("Results").Cells(i, idx_pin_vr) = wb_mpa.Worksheets("Pin").Cells(j, idx_pinC_mpa) & ":" & wb_mpa.Worksheets("Pin").Cells(j, idx_pinA_mpa) And wb_vr.Worksheets("Results").Cells(i, idx_CatModule_vr) = wb_mpa.Worksheets("Pin").Cells(j, idx_CatModule_mpa) Then

feuil1.Cells(index, 1).Value = wb_vr.Worksheets("Results").Cells(i, idx_CatModule_vr).Value

feuil1.Cells(index, 2).Value = wb_vr.Worksheets("Results").Cells(i, idx_SigName_vr).Value

feuil1.Cells(index, 3).Value = wb_vr.Worksheets("Results").Cells(i, idx_ConMean_vr).Value

feuil1.Cells(index, 4).Value = wb_vr.Worksheets("Results").Cells(i, idx_Gauge_vr).Value

feuil1.Cells(index, 5).Value = wb_vr.Worksheets("Results").Cells(i, idx_WireColor_vr).Value

feuil1.Cells(index, 6).Value = wb_vr.Worksheets("Results").Cells(i, idx_pin_vr).Value

feuil1.Cells(index, 7).Value = wb_mpa.Worksheets("Pin").Cells(j, idx_CatModule_mpa).Value

feuil1.Cells(index, 8).Value = wb_mpa.Worksheets("Pin").Cells(j, idx_SigName_mpa).Value

feuil1.Cells(index, 9).Value = wb_mpa.Worksheets("Pin").Cells(j, idx_ConMean_mpa).Value

feuil1.Cells(index, 10).Value = wb_mpa.Worksheets("Pin").Cells(j, idx_Gauge_mpa).Value

feuil1.Cells(index, 11).Value = wb_mpa.Worksheets("Pin").Cells(j, idx_WireColor_mpa).Value

feuil1.Cells(index, 12).Value = wb_mpa.Worksheets("Pin").Cells(j, idx_pinC_mpa).Value & ":" & wb_mpa.Worksheets("Pin").Cells(j, idx_pinA_mpa).Value

If feuil1.Cells(index, 1).Value <> feuil1.Cells(index, 7).Value Then

Cells(index, 13).Value = "X"

feuil1.Cells(index, 1).Interior.ColorIndex = 3

End If

If feuil1.Cells(index, 2).Value <> feuil1.Cells(index, 8).Value Then

Cells(index, 13).Value = "X"

feuil1.Cells(index, 2).Interior.ColorIndex = 3

End If

If feuil1.Cells(index, 3).Value <> feuil1.Cells(index, 9).Value Then

Cells(index, 13).Value = "X"

feuil1.Cells(index, 3).Interior.ColorIndex = 3

End If

If feuil1.Cells(index, 4).Value <> feuil1.Cells(index, 10).Value Then

Cells(index, 13).Value = "X"

feuil1.Cells(index, 4).Interior.ColorIndex = 3

End If

If feuil1.Cells(index, 5).Value <> feuil1.Cells(index, 11).Value Then

Cells(index, 13).Value = "X"

feuil1.Cells(index, 5).Interior.ColorIndex = 3

End If

If feuil1.Cells(index, 6).Value <> feuil1.Cells(index, 12).Value Then

Cells(index, 13).Value = "X"

feuil1.Cells(index, 6).Interior.ColorIndex = 3

End If

index = index + 1

Exit For

End If

'End If

Next j

Next i

Rechercher des sujets similaires à "comparaison boucles"