Saisie lente en VBA

Version imprimable

Saisie lente en VBA

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:

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

30/07/2008, 12h11
tirex28

Bonjour,

Quel est le code de cette fonction?

Code:

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

Cordialement,

Tirex28/
30/07/2008, 13h00
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...
30/07/2008, 13h13
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/
30/07/2008, 13h24
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.

Re,

Il me semble que tu devrais pouvoir remplacer ceci:
Code:

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:

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:

1 2 3 err_dbl = False If trouve_identique("B", FrmEngt.TxtNumFact.Value) = True Then err_dbl = True
Est équivalent à:

Code:

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

Quant à faire:
Code:

1 2 3 4 5 If (err_dbl = False) Then 'actions Else 'autres actions End If
Cela revient à:
Code:

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:

1 2 3 Application.Calculation = xlCalculationManual ... Application.Calculation = xlCalculationAutomatic
Bonne chance,

Tirex28/

30/07/2008, 14h05
NEC14

Bonjour,

J'ai mis en place les modifications proposées, mais le problème persiste, à savoir le lenteur du transfert des données.
Je vais encore chercher si je ne trouve pas je laisse tomber, je ne vais pas perdre de temps là dessus.
A + :cry:

Dans les lignes vérifiant si chaque contrôle est renseigné, tu passes en revue tous les contrôles. Tu gagnerais à vérifier un contrôle à la fois. Ex
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 If FrmEngt.CmbNumEng = "" Then Vmess = "Le N° d'Engagement" ElseIf FrmEngt.TxtNumFact = "" Then Vmess = "Le N° de Facture" ElseIf FrmEngt.TxtDateFact = "" Then Vmess = "La Date de la Facture" ElseIf FrmEngt.TxtMontFact = "" Then Vmess = "Le Montant" End If If Vmess <> "" Then MsgBox "Vérifiez vous avez oublié" + Vmess, , "Avertissement" Exit Sub End If
Si l'utilisateur a oublié plusieurs champs, c'est qu'il est vraiment distrait ;)
Ce n'est pas ce qui accélérera beaucoup ton code mais le conseil de Tirex devrait arranger ça

Citation:

'En début de code
Application.Calculation = xlCalculationManual
'ou plutôt
Worksheets("NomDeLaFeuille").EnableCalculation = False

...
'en fin de code
Worksheets("NomDeLaFeuille").Calculate
'Et
Application.Calculation = xlCalculationAutomatic

A+

01/08/2008, 08h24
NEC14

Bonjour,

J'ai donc fait les modif proposées, mais rien ne change quant à la rapidité d'exécution. De plus, j'ai fait le c.. j'ai fait une fausse manip et j'ai perdu tout mon fichier, pas de sauvegarde puisque je travaillais sur mon dique dur, il faut donc que je reprenne tout depuis le début c'est la m...
Merci pour votre aide, mais là j'ai du pain sur la planche. :( :(