Plusieurs minute pour compilation d'un code

Salut

j'ai un code qui réalise ce que je veux faire mais il prend beaucoup du temps pour se compiler. voila le code.Merci

Sub Ecart()
Dim F1 As Worksheet
Dim F2 As Worksheet
Dim R1 As Range
Dim R2 As Range
Dim C As Range

Set F1 = Worksheets("Mai")
Set F2 = Worksheets("April")

Set Re = F1.Range("G2", F1.Range("G65536").End(xlUp))

  For Each C In Re

        Set R1 = F1.Range("G:G").Find(Trim(C.Value), lookat:=xlPart)
        Set R2 = F2.Range("G:G").Find(Trim(C.Value), lookat:=xlPart)

      If Not R2 Is Nothing Then
        F1.Cells(R1.Row, "X").Value = (F1.Cells(R1.Row, "N").Value) - (F2.Cells(R2.Row, "N").Value)
      End If

  Next C

End Sub

Salut , qu’entends-tu « prends beaucoup de temps » ? ^^

une solution serait de passer par des tableaux je pense, une idée pour démarrer:

sub TOTO()

Dim MON_TABLEAU_R1 As Variant
Dim MON_TABLEAU_R2 As Variant
Dim BALAYAGE_TABLEAU_R1 As Integer
Dim BALAYAGE_TABLEAU_R2 As Integer

MON_TABLEAU_R1 = Worksheets("Mai").UsedRange
MON_TABLEAU_R2 = Worksheets("April").UsedRange

'si les deux feuilles Mai et April (d'ailleurs attention tu as du francais/anglais mélanger dans ton classeur :D) sont trop grosses
'on pourra toujours limiter sur la colonne G sur les cases non vides, à voir

'on balaye tout le tableau, correspond à ton for each C
For BALAYAGE_TABLEAU_R1 = LBound(MON_TABLEAU_R1) To UBound(MON_TABLEAU_R1)

    'on va balayer tout le tableau R2 voir si on retrouve la même chaine de caractère
    'si tu as classé (ou peux le faire) les valeurs des colonnes G par ordre croissant/décroissant avant de faire
    'cette macro, on peut gagner pas mal de temps car de base on va devoir si taper toute la colonne G du R2 à chaque fois

    For BALAYAGE_TABLEAU_R2 = LBound(MON_TABLEAU_R2) To UBound(MON_TABLEAU_R2)
        If MON_TABLEAU_R1(BALAYAGE_TABLEAU_R1, 7) = MON_TABLEAU_R2(BALAYAGE_TABLEAU_R2, G) Then       

            'on modifies le tableau R1
             'ton  F1.Cells(R1.Row, "X").Value = (F1.Cells(R1.Row, "N").Value) - (F2.Cells(R2.Row, "N").Value) qu'il faut refaire dans via les tableau R1 et R2

            'on sort car on a trouvé l'itération
            Exit For

        End If
    Next

Next

'on recopie le tableau R1
Worksheets("Mai").UsedRange = MON_TABLEAU_R1

End Sub

ECG

Bonjour,

Il faudrait voir à diminuer les recherches, voire faire du séquentiel en ordonnant les valeurs à rechercher et les valeurs des feuilles F1 et F2

Il est probable aussi qu'ajouter une colonne avec une formule de type EQUIV accélère la recherche

As-tu un fichier même tronqué ?

Bonjour,

Une contribution as étudier :

Option Explicit

Sub Ecart()
Dim ws As Worksheet, ws2 As Worksheet
Dim n As Long, n2 As Long
Dim rng As Range, rng2 As Range, Cell As Range, rCell As Range
Dim xlCalcul As Long
    '-------------------------------------------------------------------------------------
    xlCalcul = Application.Calculation
    Application.Calculation = xlCalculationManual
    '-------------------------------------------------------------------------------------
    Set ws = Worksheets("Mai")
    Set ws2 = Worksheets("Avril")
    With ws
        n = .Cells(Rows.Count, 7).End(xlUp).Row
        Set rng = .Cells(2, 7).Resize(n - 1)
    End With
    With ws2
        n2 = .Cells(Rows.Count, 7).End(xlUp).Row
        Set rng2 = .Cells(2, 7).Resize(n2 - 1)
    End With
    '-------------------------------------------------------------------------------------
    For Each Cell In rng
        Set rCell = rng2.Find(Trim(Cell.Value), lookat:=xlPart)
        If Not rCell Is Nothing Then
            Cell.Offset(, 17).Value = Cell.Offset(, 7).Value - rCell.Offset(, 7).Value
        End If
    Next Cell
    '-------------------------------------------------------------------------------------
    Application.Calculation = xlCalcul
End Sub

salut

Quand j’exécute le programme. un erreur s'affiche "overflow". merci pour votre réponse.

Re,

Je ne connais pas ce type d'erreur !...

Quelle ligne est surlignée en jaune lors de l'exécution de la procédure ?

Cdlt.