Discussion :

[lolodo]

Bonjour le forum,

Je viens vers vous cra ma macro mets plus d une journée a tourner
Mon fichier a deux feuilles, ma macro va rechercher la combinaison des lignes contenus dans la première feuille dans la seconde feuille et mettre un BINGO si elle trouve, une sorte de VLOOKUP complexe quoi.
Elle est très simple mais trop longue

Comment puis je faire pour la rendre plus rapide ???

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub macropsl()
Application.ScreenUpdating = False
For i = 5 To 2000
For j = 2 To 30000
 
If (Feuil2.Cells(i, 2).Value = Feuil3.Cells(j, 63).Value And Feuil2.Cells(i, 4).Value = Feuil3.Cells(j, 59).Value And Feuil2.Cells(i, 6).Value = Feuil3.Cells(j, 60).Value) Then
Feuil3.Cells(j, 61).Value = "BINGO"
 
 
End If
Next j
Next i
 
Application.ScreenUpdating = True
 
End Sub

Merci beaucoup pour votre aide

[kiki29]

Salut,à tenter

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
        ' ........
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True

[jfontaine]

Bonjour,

as tu essayé de mettre les calculs en supends

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.Calculation = xlCalculationManual

[gFZT82]

Bonjour lolodo,

Voici un code à tester.
L’idée, c’est de transférer les données dans un tableau avant d’effectuer le traitement.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
Sub macropsl()
Dim TabI
Dim TabJ
Dim TabK(1 To 29999)
Dim Depart As Single
Dim Arrivee As Single
Dim Duree As Long
 
    Depart = Timer
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
    With Sheets("Feuil2")
        TabI = .Range(.Cells(5, 2), .Cells(2000, 6))
    End With
    With Sheets("Feuil3")
        TabJ = .Range(.Cells(2, 59), .Cells(30000, 63))
    End With
 
    For i = 1 To 1996
        For j = 1 To 29999
            If TabI(i, 1) = TabJ(j, 5) Then
                If TabI(i, 3) = TabJ(j, 1) Then
                    If TabI(i, 5) = TabJ(j, 2) Then TabK(j) = "BINGO"
                End If
            End If
        Next j
    Next i
 
    For i = 2 To 30000
        Sheets("Feuil3").Range("BI" & i) = TabK(i - 1)
    Next i
 
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
Arrivee = Timer
MsgBox "Temps écoulé = " & Arrivee - Depart & " secondes"
End Sub

Cordialement.

[lolodo]

Merci pour vos réponses
Je vais tester ca et je vous donne les nouveaux temps ...

[lolodo]

1h20 !!!!! Ce qui est nettement mieux
Mettre la condition if en cascade marche bien grace a plusieurs if y est pour beaucoup
Merci a tous