Fonction Tri Quick Sort de JB plante[RESOLU]

[cathodique]

Bonjour,

J’ai utilisé une méthode de tri proposée par Jacques Boisgontier mais qui plante avec comme message <incompatibilté de type>.

Je pense que c’est dû au fait que certaines chaines à trier sont composées de plusieurs mots, il y aussi présence de lettres accentuées.

En effet, j’ai suivi au pas à pas et me suis aperçu qu’arrivé à la chaine « Vétérinaire Petit Tour »

Au niveau de la fonction de tri à la ligne ------>à temp =a(g)

Temp contenait la chaine Vétérinaire Petit Tour , g=9 alors que a(9) ----> incompatibilité de type

Comment résoudre ce problème? ça me dépasse.

En vous remerciant par avance.

 

[mapomme]

Bonjour Cathodique ,

temp est une variable qui a été définie au niveau module et c'est un tableau de variant au moment de l'appel de Tri.
a est le tableau d'entrée de la procédure Tri et c'est la même chose que temp.

Or Tu utilises temp comme la variable servant à faire l'échange entre deux éléments du tableau a au sein de la procédure Tri.

Porcédure Tri : Que voit VBA ?

L'instruction temp = a(g) :
On affecte au tableau temp une valeur a(g) à une dimension. Comme les deux variables sont du type Variant, VBA va transformer temp en une valeur à une dimension. temp perd donc sa qualité de tableau. Or n'oublions pas que a est aussi le tableau temp. Donc on vient de transformer le tableau temp (donc aussi a) en une variable à une dimension. La suite ne peut que mal se passer. A l’exécution de l'instruction suivante a(d) = temp , on désire affecter à l’élément a(d) le contenu de temp. Or VBA ne connait plus a comme étant un tableau, donc VBA ne sait pas quoi faire de l'expression a(d) donc soulève une erreur.

Le plus simple est de laisser temp en dehors de la procédure de tri en utilisant une variable auxiliaire aux:

Sub Tri(a, gauc, droi)
   Dim ref, g, c, aux

   ref = a((gauc + droi) \ 2)
   g = gauc: d = droi
   Do
      Do While a(g) < ref
         g = g + 1
      Loop
      Do While ref < a(d)
         d = d - 1
      Loop
      If g <= d Then
         aux = a(g)
         a(g) = a(d)
         a(d) = aux
         g = g + 1
         d = d - 1
      End If
   Loop While g <= d
   If g < droi Then Call Tri(a, g, droi)
   If gauc < d Then Call Tri(a, gauc, d)
End Sub

ou bien de re-déclarer temp comme une variable locale à la procédure tri. Dans ce cas, la variable locale temp sera déconnecté de la variable temp du niveau module :

Sub Tri(a, gauc, droi)
   Dim ref, g, c, temp

   ref = a((gauc + droi) \ 2)
   g = gauc: d = droi
   Do
      Do While a(g) < ref
         g = g + 1
      Loop
      Do While ref < a(d)
         d = d - 1
      Loop
      If g <= d Then
         temp = a(g)
         a(g) = a(d)
         a(d) = temp
         g = g + 1
         d = d - 1
      End If
   Loop While g <= d
   If g < droi Then Call Tri(a, g, droi)
   If gauc < d Then Call Tri(a, gauc, d)
End Sub

L’important est de savoir ce qu'on fait. Ce n'est pas toujours facile avec VBA qui fait des conversions implicites entre les types (surtout si on utilise des variants). On gagne en souplesse, on perd en sécurité du code. Dans notre cas, la logique aurait pu nous mettre la puce à l'oreille: on n'affecte pas une valeur à une dimension à un tableau qui est une variable à plusieurs dimensions. Mais tout le monde un jour ou l'autre commet cette bourde avec VBA.

 

[BOISGONTIER]

Bonjour,

Il faut ajouter temp dans la déclaration

Dim ref, g, c, temp

Sub Tri(a, gauc, droi)    ' Quick sort non utilisé plante bug
   Dim ref, g, c, temp
   ref = a((gauc + droi) \ 2)
   g = gauc: d = droi
   Do
      Do While a(g) < ref
         g = g + 1
      Loop
      Do While ref < a(d)
         d = d - 1
      Loop
      If g <= d Then
         temp = a(g)
         a(g) = a(d)
         a(d) = temp
         g = g + 1
         d = d - 1
      End If
   Loop While g <= d
   If g < droi Then Call Tri(a, g, droi)
   If gauc < d Then Call Tri(a, gauc, d)
End Sub

Boisgontier

 

[Dranreb]

Bonjour.
Mon objet ComboBoxLiées vous décharge complètement de ce genre de soucis.
Je joins le classeur précurseur d'un .xlam. Il est aussi possible d'implanter les modules de services nécessaires dans le classeur d'application.

 

[cathodique]

Bonjour Cathodique ,

temp est une variable qui a été définie au niveau module et c'est un tableau de variant au moment de l'appel de Tri.
a est le tableau d'entrée de la procédure Tri et c'est la même chose que temp.

Or Tu utilises temp comme la variable servant à faire l'échange entre deux éléments du tableau a au sein de la procédure Tri.

Porcédure Tri : Que voit VBA ?

L'instruction temp = a(g) :
On affecte au tableau temp une valeur a(g) à une dimension. Comme les deux variables sont du type Variant, VBA va transformer temp en une valeur à une dimension. temp perd donc sa qualité de tableau. Or n'oublions pas que a est aussi le tableau temp. Donc on vient de transformer le tableau temp (donc aussi a) en une variable à une dimension. La suite ne peut que mal se passer. A l’exécution de l'instruction suivante a(d) = temp , on désire affecter à l’élément a(d) le contenu de temp. Or VBA ne connait plus a comme étant un tableau, donc VBA ne sait pas quoi faire de l'expression a(d) donc soulève une erreur.

Le plus simple est de laisser temp en dehors de la procédure de tri en utilisant une variable auxiliaire aux:

Sub Tri(a, gauc, droi)
   Dim ref, g, c, aux

   ref = a((gauc + droi) \ 2)
   g = gauc: d = droi
   Do
      Do While a(g) < ref
         g = g + 1
      Loop
      Do While ref < a(d)
         d = d - 1
      Loop
      If g <= d Then
         aux = a(g)
         a(g) = a(d)
         a(d) = aux
         g = g + 1
         d = d - 1
      End If
   Loop While g <= d
   If g < droi Then Call Tri(a, g, droi)
   If gauc < d Then Call Tri(a, gauc, d)
End Sub

ou bien de re-déclarer temp comme une variable locale à la procédure tri. Dans ce cas, la variable locale temp sera déconnecté de la variable temp du niveau module :

Sub Tri(a, gauc, droi)
   Dim ref, g, c, temp

   ref = a((gauc + droi) \ 2)
   g = gauc: d = droi
   Do
      Do While a(g) < ref
         g = g + 1
      Loop
      Do While ref < a(d)
         d = d - 1
      Loop
      If g <= d Then
         temp = a(g)
         a(g) = a(d)
         a(d) = temp
         g = g + 1
         d = d - 1
      End If
   Loop While g <= d
   If g < droi Then Call Tri(a, g, droi)
   If gauc < d Then Call Tri(a, gauc, d)
End Sub

L’important est de savoir ce qu'on fait. Ce n'est pas toujours facile avec VBA qui fait des conversions implicites entre les types (surtout si on utilise des variants). On gagne en souplesse, on perd en sécurité du code. Dans notre cas, la logique aurait pu nous mettre la puce à l'oreille: on n'affecte pas une valeur à une dimension à un tableau qui est une variable à plusieurs dimensions. Mais tout le monde un jour ou l'autre commet cette bourde avec VBA.

Bonjour @mapomme ,

Toute ma gratitude pour tes magistrales explications. je te suis très reconnaissant car cela fait 3 jours que je tapote sur la touche F8 pour essayer de comprendre. J'avoue que j'étais à côté de la plaque.
Encore merci.
Bon week-end et joyeuses fêtes de fin d'année.

 

[cathodique]

Bonjour,

Il faut ajouter temp dans la déclaration

Dim ref, g, c, temp

Sub Tri(a, gauc, droi)    ' Quick sort non utilisé plante bug
   Dim ref, g, c, temp
   ref = a((gauc + droi) \ 2)
   g = gauc: d = droi
   Do
      Do While a(g) < ref
         g = g + 1
      Loop
      Do While ref < a(d)
         d = d - 1
      Loop
      If g <= d Then
         temp = a(g)
         a(g) = a(d)
         a(d) = temp
         g = g + 1
         d = d - 1
      End If
   Loop While g <= d
   If g < droi Then Call Tri(a, g, droi)
   If gauc < d Then Call Tri(a, gauc, d)
End Sub

Boisgontier

Bonjour @BOISGONTIER ,
Je reconnais qu'il me reste beaucoup à apprendre. il suffisait de déclarer la variable temp et ça passé!
Et dire, que durant 3 jours j'ai maltraité la touche F8.
Toute ma reconnaissance et gratitude. Vous me sauvez.

Bon week-end et joyeuses fêtes de fin d'année.

 

[cathodique]

Bonjour.
Mon objet ComboBoxLiées vous décharge complètement de ce genre de soucis.
Je joins le classeur précurseur d'un .xlam. Il est aussi possible d'implanter les modules de services nécessaires dans le classeur d'application.

Bonjour @Dranreb ,
Merci beaucoup pour ton fichier que j'utiliserai surement dans l'un de mes fichiers.
J'ajoute ton fichier à ma"bibliothèque VBA".
Encore merci, bon week-end.
Joyeuses fêtes de fin d'année.

 

[Dranreb]

ton fichier que j'utiliserai surement dans l'un de mes fichiers.

Curieux, ça suggère la bizarrerie que tu ne l'utilisera pas dans celui de la discussion …
Pourtant j'ai commencé à voir ça de mon coté (avec modules de service installés dedans), et ça à l'air d'aller très bien, mais j'ai perdu en cours de route la notion de la ChekBox et je ne sais plus comment elle doit agir …
Mais ce début, avec référence à CBxL cochée et modules de service non installés dedans, est opérationnel :

Option Explicit
Private WithEvents CL As ComboBoxLiées, TLgn() As Long, TBD(), TColVisu()
'---------------------------------------------------
Private Declare Function FindWindowA Lib "User32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLongA Lib "User32" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLongA Lib "User32" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
'-------------------------------------------------------------------------------------------------------------------------
Private Sub UserForm_Initialize()
   Set CL = CBxL.Création.ComboBoxLiées
   CL.Plage Feuil1.[A6:L6], True
   CL.Add ComboBox1, 5
   CL.Add ComboBox2, 2
   CL.Add ComboBox3, 1
   CL.Actualiser
   TBD = CL.PlgTablo.Value
   TColVisu = Array(2, 1, 5, 9, 4, 6, 7, 12)
   Me.CheckBox1.Value = False
   Me.LabDif.Visible = False
   Me.ListBox1.ColumnCount = UBound(TColVisu) + 1
   Me.ComboBox3.ListIndex = 0
   End Sub
Private Sub CL_Résultat(Lignes() As Long)
   TLgn = Lignes
   Affiche
   End Sub
Sub Affiche()
   Dim TLBx(), LLBx&, LBD&, C&
   If UBound(TLgn) < 1 Then ListBox1.Clear: Exit Sub
   ReDim TLBx(1 To UBound(TLgn), 0 To UBound(TColVisu))
   For LLBx = 1 To UBound(TLBx)
      LBD = TLgn(LLBx)
      For C = 0 To UBound(TColVisu)
         TLBx(LLBx, C) = TBD(LBD, TColVisu(C))
         Next C, LLBx
   ListBox1.List = TLBx
   End Sub
Private Sub B_Raz_Click()
   CL.Nettoyer
   End Sub