Discussion :

[stéphanie123]

bonjour,

je suis bientôt au bout de mon calvaire, la lumière au bout du tunnel, c'est peut être vous!

Voilà j'ai une base de donnée qui contient 4000 lignes quand je viens à éxécuter les 4000 lignes.

Cela dure plus de 2 minutes.

comment je peux faire pour accélérée le chmilblick!

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
Private Sub UserForm_Initialize()
    Dim Cellule As Range
    Dim balan As Range
 
    Dim oCollection As New Collection
    Dim i As Long
 
    For Each Cellule In Feuil4.Range("a2:a" & Feuil4.Range("a" & Rows.Count).End(xlUp).Row)
        AjouterItem oCollection, Cellule.Value
    Next Cellule
 
    For i = 1 To oCollection.Count
        ComBox1.AddItem oCollection.Item(i)
    Next i
End Sub

ceci est mon programme principal

[Gorfael]

Salut stéphanie123

Code :

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

ceci est mon programme principal

Pour accélérer, éviter les appzls à d'autres macros, ça ralentit (surtout avec 4000 appels).
Autre solution : nous donner tout le code exécuté lors de l'action de la macro (celui des macros applelée, des macros automatique que le code active, etc..).

Pour toi, c'est ta macro principale, mais ça ne veut pas dire que c'est dans le traitement de ces quelques lignes que tu perds le plus de temps. (hormis déjà avec l'appel).
A+

[cafeine]

Hello,

essaie de passer par un tableau ...

Code :

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

1
2
3
4
5
    MonTab = Feuil4.Range("a2:a" & Feuil4.Range("a" & Rows.Count).End(xlUp).Row).Value
 
    For i = LBound(MonTab, 1) To UBound(MonTab, 1)
        ComBox1.AddItem MonTab(i,1)
    Next i

[stéphanie123]

Hello,

essaie de passer par un tableau ...

Code :

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

1
2
3
4
5
    MonTab = Feuil4.Range("a2:a" & Feuil4.Range("a" & Rows.Count).End(xlUp).Row).Value
 
    For i = LBound(MonTab, 1) To UBound(MonTab, 1)
        ComBox1.AddItem MonTab(i,1)
    Next i

je n'arrive pas à l'adapter ce code

[mayekeul]

bonjour,
est-ce indispensable de passer par un formulaire?
car alors tu pourrais passer par une validation list
ce serait bien plus rapide

[Gorfael]

Salut stéphanie123

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Private Sub ComBox1_Change()
Dim Cellule As Range
Dim oCollection As New Collection
Dim i As Long
ComBox2.Clear
' Itération sur chaque cellule de b et appel de la procédure d'ajout
For Each Cellule In Feuil4.Range("b2:b" & Feuil4.Range("b" & Rows.Count).End(xlUp).Row)
    If Cellule(1, 0).Value = ComBox1.Value Then AjouterItem oCollection, Cellule.Value
Next Cellule
For i = 1 To oCollection.Count
    ComBox2.AddItem oCollection.Item(i)
Next i
End Sub

J'en ai pris une au hasard, c'est juste pour comprendre.
Tu crées une nouvelle collection, tu la charges avec les cellule de B dont A est égal à choix de la ComboBox1
puis tu charges ta ComboBox2 avec la collection. Pourquoi ?
N'étant pas spécialiste des collections, je ne vois pas l'avantage. En règle générale, on utilise une collection, d'après ce que j'en ai vu dans les exemples, pour éviter les doublons (et peut-être pour faire un tri ?). Mais ça demande une gestion des erreurs. Manuelle, on ne parlerait plus de vitesse, automatique, je ne la vois pas.
Donc, là, tu fais une boucle de 4000 lignes obligatoire (quoique) et une seconde boucle du nombre de lignes correspondant au critère, alors qu'on est déjà passé dans la boucle précédente sur la bonne cellule. Si, au lieu de la mettre en variable, on la charge dans la Combobox, on gagne du temps.
L'utilisation d'un .Find ou un filtrage sur A serait plus rapide, il me semble

De même, tu utilises Feuil4.Range(... & Rows.Count), plusieurs fois dans tes macros et ça me gène :
- Feuil4.Range : c'est le nom "informatique" de la feuille (celui qui n'apparaît que dans VBA). Moi je préfère le nom de l'onglet, mais c'est ton choix.
- Rows.Count : compte le nombre max de ligne de la feuille active, pas de Feuil4 => pas grave, puisque toutes les feuilles ont les mêmes limites. Mais dans ce cas, pourquoi le recalculer à chaque fois ? On le calcule une seule fois à l'ouverture et on le stocke dans une constante globale (ouais, je sais, c'est des nano, mais je regardes juste la globalité pour l'instant)

dans Private Sub Valider_Click() :
- les déclarations, mets-les juste sous le titre, ça ne change rien, sauf que tu ne les amalgames plus avec le reste du code quand tu cherches une panne (ça rend le code plus lisible quelque part)

Code :

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

1
2
3
4
5
6
7
8
9
If ComBox2 = "" Then
    MsgBox "veuillez sélectionner une conditions à la case unité "
End If
If ComBox3 = "" Then
    MsgBox "veuillez sélectionner une conditions à la case grosse machine "
End If
If ComBox4 = "" Then
    MsgBox "veuillez sélectionner une conditions à la case périodicité "
End If

moi, je verrais plutôt

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
If ComBox2 = "" Then
MsgBox "veuillez sélectionner une conditions à la case unité "
'case unité.setfocus
Exit Sub
End If
If ComBox3 = "" Then
MsgBox "veuillez sélectionner une conditions à la case grosse machine "
'case grosse machine.setfocus
Exit Sub
End If
If ComBox4 = "" Then
MsgBox "veuillez sélectionner une conditions à la case périodicité "
'case périodicité.setfocus
Exit Sub
End If]

avec le nom des case remplacées par le contrôle.
D'ailleurs, nommer les contrôles dès le début évite, surtout s'il y en a beaucoup, bien des erreurs : CboGrosMach me semble plus parlant que ComBox3 et je sais que les grosse machines sont dans la colonne C(enfin, je suppose), donc si je trouve une référence à Cbo_Gros_Mach différente de C, il y a problème.

Private Sub ComBox3_Change()
if calle(1, 0).Value = ComBox3.Value ....
C'est une méthode qui risque de te valloir des surprises:
calle(1, 1)=calle
calle(1, 0)=calle.offset(0, -1)
calle(0, 1)=calle.offset(-1, 0)
J'avoue préfèrer utiliser l'offset (qui bénéficie d'une aide). J'ai pas essayé avec une plage, mais le fait de changement de référence d'origine et d'axes me perturbe un peu. Mais chacun sa méthode.
Edit
Remplace ta macro initialize par celle-ci

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
Private Sub UserForm_Initialize()
Dim Cel As Range
Dim OCol As New Collection
Dim X As Long
On Error Resume Next
'en cas d'erreur, on continue
For Each Cel In Feuil4.Range("A2:A" & Feuil4.Range("A" & Rows.Count).End(xlUp).Row)
    OCol.Add Item:=Cel.Value, key:=Cel.Value
    'on ajoute à la collection
    If Err.Number <> 0 And Err.Number <> 457 Then
    '0:pas d'erreur, 457:élément existant dans la collection
        MsgBox Err.Description, vbCritical + vbOKOnly, "Erreur n°" & Err.Number
        Exit Sub
    End If
Next Cel
Err.Clear
On Error GoTo 0
For X = 1 To OCol.Count
    ComBox1.AddItem OCol.Item(X)
Next X
End Sub

et teste déjà si elle fonctionne, mais aussi le temps.
Par contre, je recherche le moyen de classer la collection en fonction de la clé. Pas encore trouvé. Si quelqu'un connait, ça m'interesse. Bien sûr, il reste la solution de classer la feuille avant, mais on doit pouvoir classer la collection en fonction de sa clé.
A+

[stéphanie123]

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
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
Option Explicit
 
Sub AjouterItem(ByRef oCollection As Collection, ByVal strItem As String)
    Dim oObjet As Object
    Dim ValeurPresente As Boolean
    Dim i As Long
 
    For i = 1 To oCollection.Count
        If oCollection.Item(i) = strItem Then
            ValeurPresente = True
            Exit Sub
        End If
    Next i
 
    If Not ValeurPresente Then oCollection.Add strItem
End Sub
 
Private Sub UserForm_Initialize()
    Dim Cellule As Range
    Dim balan As Range
 
    Dim oCollection As New Collection
    Dim i As Long
 
 
    For Each Cellule In Feuil4.Range("a2:a" & Feuil4.Range("a" & Rows.Count).End(xlUp).Row)
        AjouterItem oCollection, Cellule.Value
    Next Cellule
 
    For i = 1 To oCollection.Count
        ComBox1.AddItem oCollection.Item(i)
    Next i
End Sub
Private Sub ComBox1_Change()
    Dim Cellule As Range
    Dim oCollection As New Collection
    Dim i As Long
 
    ComBox2.Clear
    ' Itération sur chaque cellule de b et appel de la procédure d'ajout
    For Each Cellule In Feuil4.Range("b2:b" & Feuil4.Range("b" & Rows.Count).End(xlUp).Row)
        If Cellule(1, 0).Value = ComBox1.Value Then AjouterItem oCollection, Cellule.Value
    Next Cellule
 
    For i = 1 To oCollection.Count
        ComBox2.AddItem oCollection.Item(i)
    Next i
End Sub
 
Private Sub ComBox2_Change()
 
    Dim oCollection As New Collection
    Dim i As Long
    Dim balan As Range
 
    ComBox3.Clear
    ' Itération sur chaque cellule de c et appel de la procédure d'ajout
    For Each balan In Feuil4.Range("c2:c" & Feuil4.Range("c" & Rows.Count).End(xlUp).Row)
        If balan(1, 0).Value = ComBox2.Value Then AjouterItem oCollection, balan.Value
    Next balan
 
    For i = 1 To oCollection.Count
        ComBox3.AddItem oCollection.Item(i)
    Next i
 
End Sub
Private Sub ComBox3_Change()
 
    Dim oCollection As New Collection
    Dim i As Long
    Dim calle As Range
 
    ComBox4.Clear
    ' Itération sur chaque cellule de c et appel de la procédure d'ajout
    For Each calle In Feuil4.Range("d2:d" & Feuil4.Range("d" & Rows.Count).End(xlUp).Row)
        If calle(1, 0).Value = ComBox3.Value Then AjouterItem oCollection, calle.Value
    Next calle
 
    For i = 1 To oCollection.Count
        ComBox4.AddItem oCollection.Item(i)
 
    Next i
    If ComBox4.ListCount > 1 Then
    ComBox4.AddItem ("Tous")
    End If
 
End Sub
Private Sub CommandButton2_Click()
UserForm2.Hide
End Sub
 
Private Sub Valider_Click()
 
   If ComBox2 = "" Then
   MsgBox "veuillez sélectionner une conditions à la case unité "
   End If
   If ComBox3 = "" Then
   MsgBox "veuillez sélectionner une conditions à la case grosse machine "
   End If
   If ComBox4 = "" Then
   MsgBox "veuillez sélectionner une conditions à la case périodicité "
   End If
 
    Dim Valx, Valy, Valz, i As Integer
    Dim j As Integer
    Dim critere As String
    Dim critere1 As String
    Dim critere2 As String
 
    Sheets("Feuil3").Visible = True
    Sheets("Feuil3").Select
    Rows("2").Select
    Selection.ClearContents
    j = 2
    Valx = Me.ComBox1.Value
    Valy = Me.ComBox2.Value
    Valz = Me.ComBox3.Value
 
    'Affectation des variables critere et critere2 en fonction de la valeur des optionbutton
    If OptionButton1 = True Then
    critere = "oui"
    ElseIf OptionButton2 = True Then
    critere1 = "oui"
    ElseIf OptionButton3 = True Then
    critere2 = "oui"
        Else
    critere = "all"
    End If
 
      With Sheets("Feuil4")
        For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
            If .Cells(i, 1) = Valx Then
                If .Cells(i, 2) = Valy Then
                    If .Cells(i, 3) = Valz Or Valz = "Tous" Then
    'Permet de comparer l'option cochée avec le contenu des colonnes de la feuille4
                    If .Cells(i, 21) = critere Or critere = "all" _
                    Or .Cells(i, 20) = critere1 Or critere1 = "all" _
                    Or .Cells(i, 22) = critere2 Or critere2 = "all" Then
 
       Worksheets("Feuil4").Range("F" & i & ":G" & i & ",L" & i & ":S" & i).Copy (Worksheets("Feuil3").Range("A" & j))
 
                    j = j + 1
                    End If
                End If
            End If
        End If
    Next i
  End With
 
  Unload Me
  MsgBox ("Veuillez masquer la Feuil3 en cliquant sur le logo de droite à la fin de cette opération!")
 
 
End Sub

voici voilà

[stéphanie123]

bonjour

j'ai une base de donnée que j'ai automatisée,
je voudrais dinstéguée l'ensemble des données qui sont éditeés de la base vers une feuil"édité".
J'aimerai changée les caratéres de traits.
Pour chaque lignes copié dans la feuille"édité" mettre un caractére de traits différents du types encadré de la ligne A à la ligne Z par exemple;

exemple si la colonne d de la feuille"éditée ne change pas alors ne rien faire
sinon si la colonne d feuille"éditée change alors mettre un encadrement
sortir de la boucle..

bref, je sais pas comment m'y prendre
pouvez vous m'aidée?

[Montor]

Je te conseille de trié ces elements avant de les ajouter et tu va comparer le deuxiem le premier element avec si il sont egaux il ne sera pas ajouter
Ex
Avant Apres

Code :

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

1
2
3
4
5
6
7
8
9
 
Anne	Andre
Tony	Andre
Jack	Anne
Jack	Anne
Anne	Jack
Andre	Jack
Tony	Tony
Andre	Tony