comparaison de deux fichiers

dd41

XLDnaute Nouveau
bonjour,

je dispose d'une macro que j'utilise depuis deux mois afin de determiner la position d'un enregistrement (période N, N-1 et les deux)
cependant, le temps d'execution du code est de plus en plus long et même si j'obtiens le résultat (au bout de quelques heures) je n'arrive pas à trouver la cause de cette lenteur.

les deux fichiers sources sont sur le même classeur, le premier onglet comporte 50000 lignes et 30 colonnes et le deuxième fichier 30000 lignes et 32 colonnes

je vous transmet le code :

'créer l'onglet MAJ : 1 = nouveau ; 2 = ancien ; 3 = deux onglets

Sub maj()

Dim Reponse As String
'
Reponse = MsgBox("Créer le delta N-1?", vbYesNo, "Confirmation")

If Reponse = 6 Then

Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
Dim derlig1 As Long, derlig2 As Long, derlig3 As Long
Dim C As Range, r1, r2
Dim Rw As Range
Dim ligne As Long
Dim derli As String
Dim r As Variant

Application.ScreenUpdating = False

If Worksheets(2).AutoFilterMode Then
Worksheets(2).AutoFilterMode = False
End If

If Worksheets(1).AutoFilterMode Then
Worksheets(1).AutoFilterMode = False
End If

Sheets.Add After:=Sheets(2)
Sheets(3).Select
Sheets(3).Name = "MAJ"

Set sh1 = Worksheets(1)
Set sh2 = Worksheets(2)
Set sh3 = Worksheets("MAJ")
derlig1 = sh1.[A65536].End(xlUp).Row
derlig2 = sh2.[A65536].End(xlUp).Row

' vider sh3
sh3.Range("A1").Select
Selection.CurrentRegion.Select
Selection.Delete Shift:=xlToLeft
sh3.[A1] = "Feuille"

' copier datas feuil1
sh1.Range("A3:AK" & sh1.[A65536].End(xlUp).Row).Copy
sh3.[B2].PasteSpecial Paste:=xlPasteValues

' copier datas feuil2
sh2.Range("A3:AK" & sh2.[A65536].End(xlUp).Row).Copy
sh3.[B65536].End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
derlig3 = sh3.[B200000].End(xlUp).Row

' calcul présence
For Each C In sh3.Range("B2:B" & derlig3)
C.Offset(0, -1) = IIf(Application.WorksheetFunction.CountIf(sh1.Range("A3:A" & derlig1), C.Value) > 0, 2, 0) + IIf(Application.WorksheetFunction.CountIf(sh2.Range("A3:A" & derlig2), C.Value) > 0, 1, 0)
Next C

Application.ScreenUpdating = True

MsgBox "dossier trié.", vbOKOnly, "Macro terminée"

Else

If Reponse = 7 Then

end sub


j'ai fixé derlig3 [B200000] car quand on concatène les deux fichiers la taille est de 80000 lignes.

Je remercie ceux qui prendront le temps de me lire et de pouvoir m'aider a trouver une solution.

oliv'
 

Discussions similaires

Réponses
8
Affichages
712