TriRapide

Version imprimable

22/10/2016, 14h25
boulser

TriRapide

Bonjour

J'ai lu cette discussion.

Je suis débutant et je m'intéresse au tutoriel :

Apprendre la programmation en VBA pour EXCEL par la pratique - Première partie
Tome 1 - Des bases de la programmation à l'algorithme de classement rapide QuickRanking

j'ai pu le suivre jusqu'au code de TriBis sans problème. Mais pour les codes suivant QuickSort et TriRapide, je reçois à chaque fois un code erreur "nombre d'arguments incorrect ou affectation de propriétés incorrectes" et ne parvient pas à le corriger.
Quelqu'un pourrait-il m'éclairer, ce serait super

Merci
22/10/2016, 16h59
joe.levrai

Bonjour,

le plus simple pour tous, c'est de nous montrer l'application que tu as fais :

- la procédure du tutoriel
- la procédure de ton projet qui appelle cette procédure de tri

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
'--------------------------------------------------------------------------------------------------------------------------------------------------------
Sub TriRapide(ByRef TabDonnées() As Variant)
'--------------------------------------------------------------------------------------------------------------------------------------------------------
Dim i As Long, n As Long, TabClassés() As Variant
ReDim TabClassés(-UBound(TabDonnées) - 1 To UBound(TabDonnées) + 1)
Dim TabDébut As Long, TabFin As Long
 
' Si moins de deux données à trier alors quitte.
If Abs(UBound(TabDonnées) - LBound(TabDonnées)) < 1 Then Exit Sub
 
' Classe les 2 premiers éléments par ordre croissant.
n = LBound(TabDonnées)
If TabDonnées(n + 1) > TabDonnées(n) Then i = 1
TabClassés(n) = TabDonnées(n + 1 - i)
TabClassés(n + 1) = TabDonnées(n + i)
 
TabDébut = LBound(TabDonnées): TabFin = LBound(TabDonnées) + 2  'Limites tableau classé
 
' Boucle sur les autres éléments à classer.
For n = 2 + LBound(TabDonnées) To UBound(TabDonnées)
    ' Recherche la position dans la liste des éléments classés.
    i = TableauRecherchePosition(TabClassés(), TabDébut, TabFin, TabDonnées(n))
    ' Décale les éléments déjà classés pour faire une place.
    Call TableauDécalerElément(TabClassés(), i, TabDébut, TabFin)
    ' Insère l'élément dans la liste des éléments classés.
    TabClassés(i) = TabDonnées(n)
Next n
 
' Retourne le tableau classé :
n = LBound(TabDonnées)
 
For i = TabDébut To TabFin - 1
    TabDonnées(n) = TabClassés(i)
    n = n + 1
Next i
End Sub
 
'--------------------------------------------------------------------------------------------------------------------------------------------------------
Function TableauRecherchePosition(ByRef TabDonnées() As Variant, ByVal Début As Long, _
                    ByVal Fin As Long, ByVal ValRecherchée As Variant) As Long
'--------------------------------------------------------------------------------------------------------------------------------------------------------
Dim Milieu As Long
 
' Si nouvelle extrémité inférieure ou supérieure
If ValRecherchée <= TabDonnées(Début) Then TableauRecherchePosition = Début: Exit Function
If ValRecherchée >= TabDonnées(Fin - 1) Then TableauRecherchePosition = Fin: Exit Function
 
Do
    Milieu = (Début + Fin) / 2 'Calcule le milieu du tableau borné par Début et Fin.
    ' Si l'élément à classer est compris entre Milieu et Milieu+1
    If ValRecherchée >= TabDonnées(Milieu) And ValRecherchée <= TabDonnées(Milieu + 1) Then
        TableauRecherchePosition = Milieu + 1   ' Retourne la position où insérer l'élément.
        Exit Do             ' Sort de la boucle
    End If
    If ValRecherchée > TabDonnées(Milieu) Then  'Compare l'élément avec le milieu
        Début = Milieu + 1              'Nouvelle borne de début.
    Else
        Fin = Milieu - 1                'Nouvelle borne de fin.
    End If
Loop
End Function

C'est le code TriRapide du tutoriel
Il renvoie toujours la même erreur

22/10/2016, 18h41
joe.levrai

Il manque ta propre procédure dans laquelle tu appelles celles que tu nous montres dans ton dernier message

ces deux codes (la procédure et la fonction) ne s’exécutent pas "tout seul", on les appelles dans une procédure principale, en leur fournissant les paramètres/arguments déclarés dans leur "titre"

Voici la procédure qui l'appelle.

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
'--------------------------------------------------------------------------------------------------------------------------------------------------------
Sub ChargeLesDonnées()
'--------------------------------------------------------------------------------------------------------------------------------------------------------
 
Dim MonTableau() As Variant                         'Déclare un tableau Variant dynamique.
Dim y As Long                                       'Indique la ligne à analyser.
Dim i As Long                                       'Indice du tableau.
Dim T As Double                                     'Pour calculer la durée du traitement.
 
y = 1
While Cells(y, 1) <> ""                             'Boucle sur les lignes de la colonne A.
    ReDim Preserve MonTableau(i)                    'Redimensionne le tableau d'après l'indice.
    MonTableau(i) = Cells(y, 1)                     'Mémorise la valeur de la cellule.
    i = i + 1                                       'Incrémente l'indice du tableau.
    y = y + 1                                       'Passe à la ligne suivante.
Wend
 
T = Timer                                           'Mémorise l'heure avant le lancement du traitement.
 
Call VBO.TriRapide(MonTableau(), 1)                 'Trie les données (ordre croissant)
 
Durée = Timer - T                                   'Calcule la durée du traitement
 
Application.ScreenUpdating = False                  'Bloque la mise à jour écran.
For y = LBound(MonTableau) To UBound(MonTableau)    'Boucle sur les éléments.
    Cells(y + 1, 2) = MonTableau(y)                 'Affiche l'élément en B.
Next y
 
Application.ScreenUpdating = True                   'Mise à jour de l'écran
MsgBox "Durée = " & Durée                           'Affiche la durée.
 
End Sub

Je la lance par le bouton exécuter ou par la cette procédure, j'ai toujours la même erreur

Merci

22/10/2016, 23h09
joe.levrai

Tu transmets deux paramètres à la procédure TriRapide

Seul le tableau doit être fournis si on prête attention à la déclaration de cette procédure :

Code:

Sub TriRapide(ByRef TabDonnées() As Variant)

Et ton appel :

Code:

Call VBO.TriRapide(MonTableau(), 1)

Bonjour à tous,

J'ai un problème pour le chapitre 14 Programmer en VBA dans un formulaire Excel

Lorsque je copie le code pour charger la liste de données de la feuil6, colonne J je reçois une erreur: Variable non définie sur la ligne Call VBO.TriRapide(TabDonnnée()) ' Trie les données par ordre croissant.
Comment peut-on la corriger

Merci
Voiçi le code

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
'-------------------------------------------------------------------------------
Private Sub UserForm_Activate()
'-------------------------------------------------------------------------------
Dim y As Integer, i As Integer, TabDonnnée() As Variant
 
' Coche la case option 1 :
OptionButton1.Value = True
 
' Charge les données pour la liste ComboBox1 :
y = 2: i = 0
While Sheets("Feuil6").Cells(y, 10) <> "" ' Boucle sur les lignes de la feuille 6.
    ReDim Preserve TabDonnnée(i)          ' Dimensionne le tableau.
    TabDonnnée(i) = Sheets("Feuil6").Cells(y, 10) ' Charge les données en colonne J.
    y = y + 1: i = i + 1                  ' Passe à la ligne suivante.
Wend
Call VBO.TriRapide(TabDonnnée()) ' Trie les données par ordre croissant.
ComboBox1.Clear ' Efface toutes les anciennes données de la liste.
For i = 0 To UBound(TabDonnnée())   ' Boucle sur le tableau et...
    ComboBox1.AddItem TabDonnnée(i) ' alimente la liste déroulante.
Next i
 
End Sub

18/11/2016, 17h21
boulser

Bonjour,

Après maintes essais, si je supprime la ligne

Code:

Call VBO.TriRapide(TabDonnnée()) ' Trie les données par ordre croissant.

mon formulaire fonctionne et la liste modifiable se charge normalement mais ne trie évidement pas les données de la colonne J.
TabDonnées() est pourtant, me semble-t-il, défini au début par TabDonnées() As Variant.
Je ne comprends pas pourquoi l'erreur Variable non définie apparaît.

Merci de m'aider
18/11/2016, 17h59
joe.levrai

Bonjour,

tu dois être en option Explicit (= obligation de déclarer toutes les variables) et y'en a une qui est pas déclarée

si la ligne en jaune est sur la ligne de déclaration de la procédure VBO.... alors c'est que la variable non déclarée est dans cette procédure

si tu n'y arrives pas, il faut nous montrer la procédure telle qu'intégrée dans ton projet

Merci de ta réponse.

Voici tous les codes dans les procédures. La ligne Private Sub Userform_Activate() est en jaune et le code VBO est en bleu.

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
Option Explicit
 
 
Private Sub CommandButton1_Click()
Dim y As Integer
y = 2
Sheets("Feuil6").Cells(y, 1) = IIf(OptionButton1.Value = True, "Femme", "Homme")
Sheets("Feuil6").Cells(y, 2) = IIf(CheckBox1.Value = True, "Oui", "")
Sheets("Feuil6").Cells(y, 3) = IIf(CheckBox2.Value = True, "Oui", "")
Sheets("Feuil6").Cells(y, 4) = IIf(CheckBox3.Value = True, "Oui", "")
Sheets("Feuil6").Cells(y, 5) = IIf(CheckBox4.Value = True, "Oui", "")
Sheets("Feuil6").Cells(y, 6) = ComboBox1.Value
UserForm1.Hide
Call AjouterCouleur 'Ajoutera la couoleur si nécessaire.
End Sub
 
'-------------------------------------------------------------------------------
Private Sub UserForm_Activate()
'-------------------------------------------------------------------------------
Dim y As Integer, i As Integer, TabDonnnée() As Variant
' Coche la case option 1 :
OptionButton1.Value = True
 
' Charge les données pour la liste ComboBox1 :
y = 2: i = 0
While Sheets("Feuil6").Cells(y, 10) <> "" ' Boucle sur les lignes de la feuille 6.
    ReDim Preserve TabDonnnée(i)          ' Dimensionne le tableau.
    TabDonnnée(i) = Sheets("Feuil6").Cells(y, 10) ' Charge les données en colonne J.
    y = y + 1: i = i + 1                  ' Passe à la ligne suivante.
Wend
Call VBO.TriRapide(TabDonnnée()) 'Trie les données par ordre croissant.
ComboBox1.Clear ' Efface toutes les anciennes données de la liste.
For i = 0 To UBound(TabDonnnée())   ' Boucle sur le tableau et...
    ComboBox1.AddItem TabDonnnée(i) ' alimente la liste déroulante.
Next i
End Sub

J'ai essayé de supprimer Option Explicit mais j'ai toujours l'erreur

Merci

18/11/2016, 18h53
joe.levrai

Je ne vois pas la procédure VBO.trirapide dans ton message
18/11/2016, 19h01
boulser

J'ai repris toutes les procédures du tutoriel, chapitre 14 Programmer en VBA dans un formulaire.
18/11/2016, 19h58
joe.levrai

J'ai repris mon courage à deux mains pour te demander des choses précises de mon côté ;)

à toi de jouer
18/11/2016, 19h59
boulser

Je crois avoir compris ce qui ce passe. Je vais "essayer" de créer la fonction TriRapide.
18/11/2016, 20h01
joe.levrai

Si je te demande "ton code" (et quand bien même c'est un copier coller), c'est qu'avec le temps, on en a vu passer des "c'est idem qu'un exemple situé là"

après 40 échanges ou on arrive pas à cerner le problème, on obtient finalement le code ... qui n'est pas "exactement pareil" sur quelques virgules... s'avérant être ce qui fait planter la machine

Voilà ce que j'ai trouvé mais je n'arrive pas à faire les corrections pour mon projet.

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
Sub TriRapide(ByRef TabDonnées() As Variant)
'--------------------------------------------------------------------------------------------------------------------------------------------------------
Dim i As Long, n As Long, TabClassés() As Variant
ReDim TabClassés(-UBound(TabDonnées) - 1 To UBound(TabDonnées) + 1)
Dim TabDébut As Long, TabFin As Long
 
' Si moins de deux données à trier alors quitte.
If Abs(UBound(TabDonnées) - LBound(TabDonnées)) < 1 Then Exit Sub
 
' Classe les 2 premiers éléments par ordre croissant.
n = LBound(TabDonnées)
If TabDonnées(n + 1) > TabDonnées(n) Then i = 1
TabClassés(n) = TabDonnées(n + 1 - i)
TabClassés(n + 1) = TabDonnées(n + i)
 
TabDébut = LBound(TabDonnées): TabFin = LBound(TabDonnées) + 2  'Limites tableau classé
 
' Boucle sur les autres éléments à classer.
For n = 2 + LBound(TabDonnées) To UBound(TabDonnées)
    ' Recherche la position dans la liste des éléments classés.
    i = TableauRecherchePosition(TabClassés(), TabDébut, TabFin, TabDonnées(n))
    ' Décale les éléments déjà classés pour faire une place.
    Call TableauDécalerElément(TabClassés(), i, TabDébut, TabFin)
    ' Insère l'élément dans la liste des éléments classés.
    TabClassés(i) = TabDonnées(n)
Next n
 
' Retourne le tableau classé :
n = LBound(TabDonnées)
For i = TabDébut To TabFin - 1
    TabDonnées(n) = TabClassés(i):
    n = n + 1
Next i
End Sub

Bonjour,

Voici ce que j'ai trouvé comme solution :

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
Option Explicit
 
Sub TriCouleurs()
'
' TriCouleurs Macro
'
    Columns("J:J").Select
    ActiveWorkbook.Worksheets("Feuil6").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Feuil6").Sort.SortFields.Add Key:=Range("J1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Feuil6").Sort
        .SetRange Range("J2:J3600")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("J1").Select
End Sub
 
Private Sub CommandButton1_Click()
Dim y As Integer
y = 2
Sheets("Feuil6").Cells(y, 1) = IIf(OptionButton1.Value = True, "Femme", "Homme")
Sheets("Feuil6").Cells(y, 2) = IIf(CheckBox1.Value = True, "Oui", "")
Sheets("Feuil6").Cells(y, 3) = IIf(CheckBox2.Value = True, "Oui", "")
Sheets("Feuil6").Cells(y, 4) = IIf(CheckBox3.Value = True, "Oui", "")
Sheets("Feuil6").Cells(y, 5) = IIf(CheckBox4.Value = True, "Oui", "")
Sheets("Feuil6").Cells(y, 6) = ComboBox1.Value
UserForm1.Hide
Call AjouterCouleur 'Ajoutera la couleur si nécessaire.
End Sub
 
'-------------------------------------------------------------------------------
Private Sub UserForm_Activate()
'-------------------------------------------------------------------------------
Dim y As Integer, i As Integer, TabDonnnée() As Variant
' Coche la case option 1 :
OptionButton1.Value = True
 
Call TriCouleurs 'Trie les données par ordre croissant.
 
' Charge les données pour la liste ComboBox1 :
y = 2: i = 0
While Sheets("Feuil6").Cells(y, 10) <> "" ' Boucle sur les lignes de la feuille 6.
    ReDim Preserve TabDonnnée(i)          ' Dimensionne le tableau.
    TabDonnnée(i) = Sheets("Feuil6").Cells(y, 10) ' Charge les données en colonne J.
    y = y + 1: i = i + 1                  ' Passe à la ligne suivante.
Wend
ComboBox1.Clear ' Efface toutes les anciennes données de la liste.
For i = 0 To UBound(TabDonnnée())   ' Boucle sur le tableau et...
    ComboBox1.AddItem TabDonnnée(i) ' alimente la liste déroulante.
Next i
End Sub