Discussion :

[NEC14]

Bonjour à tous

Voici mon soucis. A partir d'une formulaire VBA sous Excel, je saisis des données dans un tableau Excel. Je suis arrivé à la 670ème lignes de saisie et le rapatriement des saisies est de plus en plus longue.
Je vous transmets mon code. Pouvez-vous m'aider à ce propos afin que les cellules dans le tableau se remplissent plus vite (en ce moment autour 10 secondes, alors qu'au début c'était immédiat).
Je vous en remercie par avance

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
Private Sub CmbOk2_Click()
Dim err_dbl As Boolean
Dim Vmess As String
Dim Ver As Integer
Vmess = ""
Ver = 0
    If FrmEngt.CmbNumEng = "" Then
    Ver = 1
    Vmess = Vmess + Chr(10) + "Le N° d'Engagement"
    End If
    If FrmEngt.TxtNumFact = "" Then
    Ver = 1
    Vmess = Vmess + Chr(10) + "Le N° de Facture"
    End If
    If FrmEngt.TxtDateFact = "" Then
    Ver = 1
    Vmess = Vmess + Chr(10) + "La Date de la Facture"
    End If
    If FrmEngt.TxtMontFact = "" Then
    Ver = 1
    Vmess = Vmess + Chr(10) + "Le Montant"
    End If
    If Ver = 1 Then
        MsgBox "Vérifiez vous avez oublié" + Vmess, , "Avertissement"
        Exit Sub
        End If
            Sheets("Factures").Activate
                If Range("A6") = "" Then
                    Range("A6").Select
                Else
                    Range("A5").End(xlDown).Select
                    ActiveCell.Offset(1, 0).Range("A1").Select
                    End If
            err_dbl = False
                If trouve_identique("B", FrmEngt.TxtNumFact.Value) = True Then
            err_dbl = True
            End If
                If (err_dbl = False) Then
                    FrmEngt.CmbNumEng.SetFocus
                    ActiveCell.Offset(0, 0).Value = FrmEngt.CmbNumEng.Value
                    ActiveCell.Offset(0, 1).Value = FrmEngt.TxtNumFact.Value
                    ActiveCell.Offset(0, 2).Value = FrmEngt.TxtDateFact.Value
                    ActiveCell.Offset(0, 4).Value = CDbl(FrmEngt.TxtMontFact)
                    ActiveCell.Offset(0, 8).Value = FrmEngt.LabOui.Caption
                    ActiveCell.Offset(0, 9).Value = FrmEngt.LabNon.Caption
                    ActiveCell.Offset(0, 16).Value = FrmEngt.CmbSite.Value
                Load FrmEngt
            FrmEngt.CmbNumEng = ""
            FrmEngt.LstMont.Clear
            FrmEngt.LstTier.Clear
            FrmEngt.LstBat.Clear
            FrmEngt.TxtNumFact = ""
            FrmEngt.TxtDateFact = ""
            FrmEngt.TxtMontFact = ""
            FrmEngt.CmbSite = ""
            FrmEngt.LabOui = ""
            FrmEngt.LabNon = "X"
        Else
        MsgBox "Attention ce numéro de facture existe déjà...Veuillez recommencer", vbOKOnly
    End If
End Sub

[tirex28]

Bonjour,

Quel est le code de cette fonction?

Code :

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

If trouve_identique("B", FrmEngt.TxtNumFact.Value) = True Then

Cordialement,

Tirex28/

[NEC14]

Bonjour,

Je ne comprends pas ta question ?
Cette fonction recherche dans la colonne "B" un numéro identique à celui que je viens de saisir, ceci pour éviter les doublons.
Ce code n'est pas correct ? Dis moi...

[tirex28]

Re,

Le code est sans doute correct puisqu'il fonctionne.

Il me semble simplement que les autres instructions s'exécuteront toujours dans le même temps quelque soit le nombre de lignes. Donc si il y une source de ralentissement liée au volume de donnée elle se trouve probablement dans le code de cette mystérieuse fonction.

Cordialement,

Tirex28/

[NEC14]

Ok, je cherche à comprendre d'où vient se ralentissement mais pour le moment je ne trouve pas.
Peut-être vais-je supprimer ce code pour voir si cela vient de lui.
Merci pour l'info.

Je viens d'essayer en supprimant ce boût de code, mais c'est toujours aussi lent. Je vais continuer à chercher.

[tirex28]

Re,

Il me semble que tu devrais pouvoir remplacer ceci:

Code :

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

1
2
3
4
5
6
        If Range("A6") = "" Then
            Range("A6").Select
        Else
            Range("A5").End(xlDown).Select
            ActiveCell.Offset(1, 0).Range("A1").Select
        End If

Par cela:

Code :

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

1
2
        Dim Cellule As Range
        Set Cellule = Range("A65536").End(xlUp).Offset(1, 0)

Tu utilise ensuite cette variable en lieu et place de ActiveCell.

Ceci:

Code :

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

1
2
3
        err_dbl = False
            If trouve_identique("B", FrmEngt.TxtNumFact.Value) = True Then
        err_dbl = True

Est équivalent à:

Code :

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

        err_dbl = trouve_identique("B", FrmEngt.TxtNumFact.Value)

Quant à faire:

Code :

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

1
2
3
4
5
   If (err_dbl = False) Then
        'actions
    Else
        'autres actions
    End If

Cela revient à:

Code :

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

1
2
3
4
5
    If err_dbl Then
        'autres actions
    Else
        'actions
    End If

La suite est un peu obscure. Dans quel formulaire se trouve ton code? S'il est dans le formulaire FrmEngt alors tu peux supprimer toutes les références à ce formulaire. Quoique il en soit je ne comprend pas pourquoi tu le recharge au milieu de la procédure puisque il est déja chargé.

D'autre part et puisque tu modifie la feuille de calcul tu peux désactiver le recalcul au début de ta procédure et le rétablir à la fin:

Code :

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

1
2
3
Application.Calculation = xlCalculationManual
...
Application.Calculation = xlCalculationAutomatic

Bonne chance,

Tirex28/