lenteur d'un code rapprochement bancaire automatique

**BENNASR** · 18/08/2015, 09h39

bonjour les super internautes, grâce à vous j'avance et je suis heureux d’être un membre de ce super site

je viens de développer une petite application ou j'importe
1/ les données d'un logiciel COMPTABILITÉ développés sous oracle à l'aide MS QUERY
2/ Un suivi sur excel des comptes bancaires se trouve dans un feuil du classeur
je lance le rapprochement à l'aide d'une formule donnée par un gentil membre de ce site :
SI(NB.SI($C$3:$C3;C3)>NB.SI($L$3:$L$162;C3);C3;"")
cette formule est transformée en code à l'aide de l'enregistreur automatique
tous est bon sauf que cette opération prenne environ 3 à 5 minutes et je demande si je peux alléger ce code et gagner encore du temps
merci à tous
code principal

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
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
Option Explicit
Sub MVT_BNA()
Dim cel As Range, plage As Range, plage1 As Range, plage2 As Range, plage3 As Range, plage4 As Range, plage5 As Range
Dim derlig As Long, derlig1 As Long, derlig2 As Long, derlig3 As Long, derlig4 As Long, derlig5 As Long
    Application.ScreenUpdating = False
    ActiveWorkbook.RefreshAll
    'suppression ancoen données
    With Worksheets("BNA")
      If Worksheets("BNA").AutoFilterMode Then
      Worksheets("BNA").AutoFilterMode = False
      End If
        derlig = .Range("A" & Rows.Count).End(xlUp).Row
        Set plage = .Range("A3:A" & derlig)
        derlig1 = .Range("B" & Rows.Count).End(xlUp).Row
        Set plage1 = .Range("B3:B" & derlig1)
        derlig2 = .Range("C" & Rows.Count).End(xlUp).Row
        Set plage2 = .Range("C3:C" & derlig2)
      If .Range("A3") <> "" Then
        plage.ClearContents
        plage1.ClearContents
        plage2.ClearContents
      End If
    End With
      With Worksheets("BNA")
     derlig4 = .Range("D" & Rows.Count).End(xlUp).Row
     Set plage4 = .Range("D3:D" & derlig4)
     derlig5 = .Range("M" & Rows.Count).End(xlUp).Row
     Set plage5 = .Range("M3:M" & derlig5)
        If 1 = 1 Then
        plage4.ClearContents
        plage5.ClearContents
        End If
    End With
    'insertion nv données
    With Worksheets("Mouvement")
        derlig3 = .Range("A" & Rows.Count).End(xlUp).Row
        Set plage3 = .Range("A11:A" & derlig3)
    End With
    For Each cel In plage3
        If cel = "BNA" And cel(, 2) > Sheets("BNA").Range("A1") And cel(, 9) <> 0 Then
            Worksheets("BNA").Cells(Rows.Count, 1).End(xlUp)(2) = cel(, 2)
            Worksheets("BNA").Cells(Rows.Count, 1).End(xlUp)(1, 2) = cel(, 5)
            Worksheets("BNA").Cells(Rows.Count, 1).End(xlUp)(1, 3) = cel(, 9)
        End If
    Next cel
    'mise en forme date
    Worksheets("BNA").Range("A3:A" & derlig1).Select
    Selection.NumberFormat = "m/d/yyyy"
    ' formule de rapprochement
    Call SLD_BNA
 
    Call formuleBNA
 
    Application.ScreenUpdating = True
    MsgBox "Rapprochement terminé...veuillez patienter encore quelques secondes"
 
End Sub

Code enregistré à l'aide de l'enregistreur

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
Sub formuleBNA()
'
' Macro4 Macro
'
With Worksheets("BNA")
If 1 = 1 Then
    Range("D3").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(COUNTIF(R3C3:RC3,RC[-1])>COUNTIF(R3C12:R5000C12,RC[-1]),RC[-1],"""")"
    Range("D3").Select
    Selection.AutoFill Destination:=Range("D3:D5000"), Type:=xlFillDefault
    Range("D3:D5000").Select
    Range("M3").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(COUNTIF(R3C12:RC12,RC[-1])>COUNTIF(R3C3:R5000C3,RC[-1]),RC[-1],"""")"
    Range("M3").Select
    Selection.AutoFill Destination:=Range("M3:M5000"), Type:=xlFillDefault
    Range("M3:M5000").Select
    End If
End With
End Sub
' code pour faire le solde de chaque mouvement de la comptabilité : débit - crédit
Sub SLD_BNA()
 
With Worksheets("BNA")
If 1 = 1 Then
   Range("L3").Select
    ActiveCell.FormulaR1C1 = _
        "=IF([@[DAT_PIE_MVT]]<>"""",[@[MNT_DEB_MVT]]-[@[MNT_CRE_MVT]],"""")"
    Range("L3").Select
    Selection.AutoFill Destination:=Range("L3:L5000"), Type:=xlFillDefault
    Range("L3:L5000").Select
    End If
End With
End Sub

**el_slapper** · 18/08/2015, 10h57

un peu de nettoyage, déjà; Quand tu as un with, tu n'as besoin que du point pour référencer l'objet jusqu'au End With :

Code :

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

1
2
    With Worksheets("BNA")
      If Worksheets("BNA").AutoFilterMode Then

peut devenir

Code :

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

1
2
    With Worksheets("BNA")
      If.AutoFilterMode Then

et tu en as d'autres. Ça te fais économiser quelques références mémoire, soit pas grand chose(mais c'est plus propre et ça facilite la maintenance).

Ensuite, il serait bon de savoir laquelle de test 3 boucles(le for each dans le programme principal, et tes deux procédures formuleBNA et SLD_BNA) pose problème. Si tu mets une msgbox à l'issue de chaque, tu verras tout de suite là ou ça va vite... et là ou il faut attendre.

J'ai quand même un petit doute sur le "5000" qu'on retrouve dans tes procédures. Est-ce que tu as vraiment 5000 lignes à remplir? En plus, tu as laissé tous les .select, qui font typiquement perdre du temps. En plus, il t'a mis un with dont tu ne te sers pas.

Essaye avec quelquechose du style :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub formuleBNA()
'
With Worksheets("BNA")
If 1 = 1 Then
    .Range("D3").ActiveCell.FormulaR1C1 = _
        "=IF(COUNTIF(R3C3:RC3,RC[-1])>COUNTIF(R3C12:R5000C12,RC[-1]),RC[-1],"""")"
    .Range("D3").AutoFill Destination:=Range("D3:D5000"), Type:=xlFillDefault
    .Range("M3").ActiveCell.FormulaR1C1 = _
        "=IF(COUNTIF(R3C12:RC12,RC[-1])>COUNTIF(R3C3:R5000C3,RC[-1]),RC[-1],"""")"
    .Range("M3").AutoFill Destination:=Range("M3:M5000"), Type:=xlFillDefault
    End If
End With
End Sub

Ça ne seras pas miraculeux, mais ça peut aider. Si en plus on peut identifier comment tu remplis ton 5000, et le remplacer par une valeur calculée, on peut faire la même chose au plus juste.

Après, je ne sais pas si le "autofill" est performant. Il y a peut-être des solution "code" plus efficaces(mais je ne suis pas un pro des formules).

**BENNASR** · 18/08/2015, 11h34

Merci pour la réponse :
t's raison pour ce 5000 ligne
je suis pas pro et j'ai pas arrivé à ce limiter au nombre des ligne pour ça j'ai mis 5000 surtout que le code est généré par l'enregistreur automatique et je demande si je peux limité le code d'application de cette formule au nombre des lignes importés
merci encore

**el_slapper** · 18/08/2015, 14h23

Tu peux, mais ça demande un peu de travail.

Si on suppose que le nombre réel de lignes à traiter est le même qu'en ligne A, on peut stocker ce résultat dans une variable intermédiaire. Par exemple :

Code :

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

1
2
3
4
5
6
7
8
9
10
'
With Worksheets("BNA")
    derniereLigne = Cstr(.Range("A65535").End(xlUp).Row)
    .Range("D3").ActiveCell.FormulaR1C1 = _
        "=IF(COUNTIF(R3C3:RC3,RC[-1])>COUNTIF(R3C12:R" & derniereLigne  & "C12,RC[-1]),RC[-1],"""")"
    .Range("D3").AutoFill Destination:=Range("D3:D" & derniereLigne ), Type:=xlFillDefault
    .Range("M3").ActiveCell.FormulaR1C1 = _
        "=IF(COUNTIF(R3C12:RC12,RC[-1])>COUNTIF(R3C3:R" & derniereLigne  & "C3,RC[-1]),RC[-1],"""")"
    .Range("M3").AutoFill Destination:=Range("M3:" & derniereLigne ), Type:=xlFillDefault
End With

ça remplace 5000 par la dernière ligne remplie de la colonne A. A adapter selon ton besoin, bien évidemment.

**BENNASR** · 18/08/2015, 15h05

je te remercie monsieur pour la réponse qui me demande un peu de temps pour la comprendre
bonne journée et je vous informera des résultats
Encore BONNE JOURNEE

**joe.levrai** · 19/08/2015, 00h15

Bonjour,

une proposition sans passer par des sous-procédures

je fais ça en aveugle, si y'a un souci n'hésite pas à joindre un classeur exemple pour y voir plus clair

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
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
Option Explicit
Sub MVT_BNA()
Dim Cell As Range
Dim Sh As Worksheet
Dim DerLig As Long
 
ThisWorkbook.RefreshAll
 
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With
 
With ThisWorkbook.Worksheets("BNA")
    If .AutoFilterMode Then .AutoFilterMode = False
 
    'suppression anciennes données
    DerLig = .UsedRange.Rows.Count + 2  ' +2 au cas où A1 et A2 sont vides
    If .Range("A3") <> "" Then Union(.Range("A3:D" & DerLig), .Range("M3:M" & DerLig)).ClearContents
 
    'insertion nv données
    Set Sh = ThisWorkbook.Worksheets("Mouvement")
    DerLig = Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row - 2  ' -2 pour écarter les lignes 1 et 2
    ' chaque cellule de la colonne A de la feuille mouvement
    For Each Cell In Sh.Cells(3, 1).Resize(DerLig, 1).Cells
        If Cell.Value = "BNA" _
        And Cell.Offset(0, 1).Value > .Cells(1, 1).Value _
        And Cell.Offset(0, 8).Value <> 0 Then
 
            With .Cells(.Rows.Count, 1).End(xlUp)(2)
                .Value = Cell.Offset(0, 1).Value
                .Offset(0, 1).Value = Cell.Offset(0, 4).Value
                .Offset(0, 2).Value = Cell.Offset(0, 8).Value
            End With
 
        End If
    Next Cell
 
    DerLig = .Cells(.Rows.Count, 1).End(xlUp).Rows
    With .Cells(3, 1).Resize(DerLig - 2, 1)
        ''mise en forme date de la colonne A
        .NumberFormat = "m/d/yyyy"
 
        'colonne D
        With .Offset(0, 3)
            ' écriture des formules
            .FormulaR1C1 = "=IF(COUNTIF(R3C3:RC3,RC[-1])>COUNTIF(R3C12:R" & DerLig & "C12,RC[-1]),RC[-1],"""")"
            ' remplacement de la formule par son résultat
            '.Value = .Value
        End With
 
        'colonne M
        With .Offset(0, 12)
            ' écriture des formules
            .FormulaR1C1 = "=IF(COUNTIF(R3C12:RC12,RC[-1])>COUNTIF(R3C3:R" & DerLig & "C3,RC[-1]),RC[-1],"""")"
            ' remplacement de la formule par son résultat
            '.Value = .Value
        End With
 
        'colonne L
        With .Offset(0, 11)
            ' écriture des formules
            .FormulaR1C1 = "=IF([@[DAT_PIE_MVT]]<>"""",[@[MNT_DEB_MVT]]-[@[MNT_CRE_MVT]],"""")"
            ' remplacement de la formule par son résultat
            '.Value = .Value
        End With
    End With
 
End With
 
With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With
 
MsgBox "Rapprochement terminé...veuillez patienter encore quelques secondes"
 
End Sub

lenteur d'un code rapprochement bancaire automatique [XL-2010]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager