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".
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