Discussion :

[swirzel]

Bonjour à toutes et à tous,

Voila mon problème: j'ai écrit un petit programme sous VBA pour modifier un tableau assez conséquent (plus de 40 000 lignes).

Le programme marche bien si ce n'est que je doit appuyer sur la touche "échap" quelques secondes après l'avoir lancé pour visualiser les modifications que je veux ET pour que Excel arrête de ramer pour rien (je vois le processeur monter en charge petit à petit.. 10%...12%...14%...etc)

C'est comme si j'avais lancé une boucle infinie .. mais en mettant des stops aux endroits clefs pour voir comment se comporte le programme et où ça pouvait bloquer éventuellement, il se trouve que l'endroit faisant tout "capoter" étant juste avant de changer certaines cellules du tableau (les 4 dernières lignes)

Je précise que le script est sur une feuille et non un module, que certaines valeurs d'entrée sont récupérées depuis des userform et que j'ai eu quelques soucis du genre "erreur 400" et "erreur 1004" avant que ça fonctionne (j'ai dû changer cells(x,j) en application.cells(x,j).value)

Voila mon programme ci-dessous:

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
Sub LancementProgramme2()

Dim RefLM As Long, CapaLin As Integer, DateModif As Date, NomPers As String, BoiteDial, i As Long, Nrow As Long, LigneRef As Long, boitedial2

' Récupération des variables renseignées dans les champs de la feuille CAPA

RefLM = TextBox1.Value
CapaLin = TextBox2.Value
DateModif = TextBox3.Value
NomPers = TextBox4.Value


'Comptage du nombre de lignes

Nrow = Range("A65536").End(xlUp).Row

'Vérification si la référence LM est déjà dans le tableau

LigneRef = 999999999

For i = 2 To Nrow
    If Cells(i, 1) = RefLM Then LigneRef = i
Next

If LigneRef = 999999999 Then boitedial2 = MsgBox("La référence que vous avez renseigné n'est pas dans le tableau, voulez-vous créer une nouvelle référence?", vbYesNo, "Attention")
    If boitedial2 = vbYes Then LigneRef = Nrow + 1
    If boitedial2 = vbNo Then Exit Sub

Application.Cells(LigneRef, 1).Value = RefLM
Application.Cells(LigneRef, 2).Value = CapaLin
Application.Cells(LigneRef, 4).Value = DateModif
Application.Cells(LigneRef, 5).Value = NomPers


End Sub

Merci d'avance pour votre aide!!

[Menhir]

Juste après ton "Nrow = ...", mets la ligne :

Code :

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

1
2
3
Debug.Print Nrow
Debug.Print ActiveSheet.Name
Debug.Print  Range("A65536").Parent.Name

Lance la macro et regarde dans la fenêtre d'exécution le résultat de ces trois instructions.

[swirzel]

Ça donne:

41606
CAPA
CAPA

41606 est le nombre de lignes du tableau.
CAPA étant le nom de la feuille dans laquelle j'ai le tableau.

[Menhir]

"Quelques secondes", c'est peut-être normal pour tester une telle quantités de lignes.

Tu n'aurais pas aussi des macro évènementielles, des calculs complexes comme des formules matricielles, des formules sur chacune de tes lignes ?

[swirzel]

En fait c'est plus que quelques secondes, ça met en charge le processeur sans fin..

Si je fait "echap" quelques secondes après avoir lancé le programme (quand le processeur commence à monter en charge), ça marche..

Et non je n'ai rien de tout ça, justement, c'est ce qui m'étonne! Le plus étonnant, comme je l'ai mis dans mon premier post, c'est que si je mets un "stop" dans mon programme APRÈS avoir cherché la valeur RefLM dans le gros tableau (ce qui est censé prendre le plus de temps), ça ne rame pas. Ca rame au niveau des dernières lignes du programme, quand je renseigne les cases de la ligne correspondante avec:

Code :

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

1
2
3
4
Application.Cells(LigneRef, 1).Value = RefLM
Application.Cells(LigneRef, 2).Value = CapaLin
Application.Cells(LigneRef, 4).Value = DateModif
Application.Cells(LigneRef, 5).Value = NomPers

C'est ce bloc qui fait tout ramer.. c'est ce que je ne comprends pas!

[Marc-L]

Bonjour !

Déjà dans le code il y a un gros souci de logique au niveau des lignes n°25 à 27
devant toutes être dans le même bloc d'instructions If !

L'exécution de ce code est déjà ralenti par l'utilisation d'une boucle,
à remplacer par exemple par la méthode Range.Find ou encore comme dans la
démonstration suivante par Match correspondant à la fonction de feuille de calculs EQUIV :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Sub LancementProgramme2()
   Dim RefLM As Long, V
       RefLM = TextBox1.Value
           V = Application.Match(RefLM, ActiveSheet.UsedRange.Columns(1), 0)
If IsError(V) Then
    If MsgBox("La référence que vous avez renseigné n'est pas dans le tableau, voulez-vous créer une nouvelle référence?", vbYesNo, "Attention") = vbNo Then Exit Sub
    V = Cells(Rows.Count, 1).End(xlUp).Row + 1
End If
    Cells(V, 1).Resize(, 2).Value = Array(RefLM, TextBox2.Value)
    Cells(V, 4).Resize(, 2).Value = Array(TextBox3.Value, TextBox4.Value)
End Sub

___________________________________________________________________________________________________________

     Merci de cliquer sur en bas à droite de chaque message ayant aidé puis sur pour clore cette discussion …