XL 2010 Trier, en VBA, un Array par ordre alphabétique

Magic_Doctor

XLDnaute Barbatruc
Bonjour,

Je me heurte à un problème apparemment simple.
J'ai un Array :
Liste = Array("jaune", "vert", "orange", "blanc", "rouge", "noir", "fuchsia", "marron")

Comment le trier par odre alphabétique, afin d'obtenir :
Liste = Array("blanc", "fuchsia","jaune", "marron", "noir", "orange", "rouge", "vert")

Merci d'avance pour toute réponse.
 
Solution
Cela dit en VBA on s'en sort très bien en utilisant 2 tableaux a et b, fichier (2) :
VB:
Private Sub Combobox1_GotFocus()
Dim a, b, x%
a = Array("jaune", "vert", "guaraní", "georgien", "rouge", "noir", "fuchsia", "marron") 'tableau à une dimension sans accents et en minuscules, à adapter
b = Array("jaune", "vert", "Guaraní", "Géorgien", "rouge", "noir", "fuchsia", "marron") 'tableau à une dimension avec accents, à adapter
tri a, b, 0, UBound(a)
ComboBox1.List = b 'liste avec accents
ComboBox1.DropDown 'déroule la liste
End Sub

Sub tri(a, b, gauc, droi) ' Quick sort
Dim ref, g, d, 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 <=...

patricktoulon

XLDnaute Barbatruc
re
discussion dépacée
 
Bonjour le fil le forum
@Yeahou: ben non en fait l'astuce n'est pas valable dans tout les sens
sur les tablo 2 dim en base 0 c'est pas bon
Patrick , étant donné qu'ils contiennent le même nombre de valeurs et peuvent s'attaquer de la même façon que les tableaux unidimensionnels, peux-tu m'expliquer l'intérêt de les différencier ? ou c'est juste une question de principe ?

Bien amicalement, @+
Bernard
 

patricktoulon

XLDnaute Barbatruc
re
Bonjour @Yeahou
ben non justement il ne s'attaquent pas de la même manière
exemple1 :
dim tablo( 0 to 5) :tablo(2)="toto"
et
exemple 2:
dim tablo2(0 to 5,0):tablo(2,0)="toto"

ne sont pas les mêmes types de tableaux

essaie donc de faire msgbox tablo2(2) à la place de msgbox tablo2(2,0)
;)
 

Magic_Doctor

XLDnaute Barbatruc
Cela dit en VBA on s'en sort très bien en utilisant 2 tableaux a et b, fichier (2) :
VB:
Private Sub Combobox1_GotFocus()
Dim a, b, x%
a = Array("jaune", "vert", "guaraní", "georgien", "rouge", "noir", "fuchsia", "marron") 'tableau à une dimension sans accents et en minuscules, à adapter
b = Array("jaune", "vert", "Guaraní", "Géorgien", "rouge", "noir", "fuchsia", "marron") 'tableau à une dimension avec accents, à adapter
tri a, b, 0, UBound(a)
ComboBox1.List = b 'liste avec accents
ComboBox1.DropDown 'déroule la liste
End Sub

Sub tri(a, b, gauc, droi) ' Quick sort
Dim ref, g, d, 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
      temp = b(g): b(g) = b(d): b(d) = temp
      g = g + 1: d = d - 1
    End If
Loop While g <= d
If g < droi Then Call tri(a, b, g, droi)
If gauc < d Then Call tri(a, b, gauc, d)
End Sub

Cela dit en VBA on s'en sort très bien en utilisant 2 tableaux a et b, fichier (2) :
VB:
Private Sub Combobox1_GotFocus()
Dim a, b, x%
a = Array("jaune", "vert", "guaraní", "georgien", "rouge", "noir", "fuchsia", "marron") 'tableau à une dimension sans accents et en minuscules, à adapter
b = Array("jaune", "vert", "Guaraní", "Géorgien", "rouge", "noir", "fuchsia", "marron") 'tableau à une dimension avec accents, à adapter
tri a, b, 0, UBound(a)
ComboBox1.List = b 'liste avec accents
ComboBox1.DropDown 'déroule la liste
End Sub

Sub tri(a, b, gauc, droi) ' Quick sort
Dim ref, g, d, 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
      temp = b(g): b(g) = b(d): b(d) = temp
      g = g + 1: d = d - 1
    End If
Loop While g <= d
If g < droi Then Call tri(a, b, g, droi)
If gauc < d Then Call tri(a, b, gauc, d)
End Sub
Bonjour job, le forum,

J'ai regardé de plus près ta procédure (qui marche très bien). Plutôt que d'avoir à y mettre 2 arrays : l'original (indispensable) avec les diacritiques et sa duplication sans diacritiques, j'ai fait la modification suivante :
VB:
Private Sub Combobox1_GotFocus()
'job75 / Magic_Doctor

Dim liste1, liste2, liste3, nb%, i%

    liste1 = Array("Lézard", "Iguane", "Araignée", "Panda", "Chauve-souris", "Zèbre", "Éléphant", "Ornithorynque", "Mangouste", "Rhinocéros", "Ñandú", "Cotorra", "Gorille", "Mulita", _
                   "Kangourou", "Wallaby ", "Castor", "Tigre", "Caméléon", "Pangolin", "Ouistiti", "Vache", "Crotale", "Ragondin", "Girafe", "Léopard", "Chapon", "Kazoar", "Lion", "Guépard", _
                   "Yack", "Crapaud buffle", "Wapiti", "Quokka", "Veuve noire", "Jaguar", "Axalotl", "Xénope", "Buffle")
    nb = (UBound(liste1) - LBound(liste1)) + 1  'nombre d'items dans l'Array "liste1"

    'Obligé de bidouiller ça, sinon les diacritiques n'apparaissent pas...
    ReDim liste2(nb - 1)
    For i = 0 To nb - 1
        liste2(i) = liste1(i)  'duplication ad integrum de l'Array "Liste1"
    Next
   
    ReDim liste3(nb - 1)
    For i = 0 To nb - 1
        liste3(i) = NoMoreDiacritiques(liste1(i))  'dresse une réplique de l'Array "Liste1" avec suppression des éventuels diacritique de tous les items
    Next

    Tri liste3, liste2, 0, UBound(liste2)
    ComboBox1.List = liste2  'liste avec accents
    ComboBox1.DropDown       'déroule la liste
End Sub
VB:
Function NoMoreDiacritiques(txt, Optional chx As Byte)
'*****************************************************************************************
'Suppression de tous les dicritiques d'une chaîne de caractères

'- txt : une chaîne de caractères
'- chx : si omis --> seules les diacritiques sont supprimés
'        = 1     --> les diacritiques sont supprimés et le texte est tout en MAJUSCULES
'        = 2     --> les diacritiques sont supprimés et le texte est tout en minuscules
'*****************************************************************************************

Dim i&
Const AccChars = "ŠŽšžŸÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïðñòóôõöùúûüýÿ"
Const RegChars = "SZszYAAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaceeeeiiiidnooooouuuuyy"
 
    For i = 1 To Len(AccChars)
        txt = Replace(txt, Mid(AccChars, i, 1), Mid(RegChars, i, 1))
    Next
   
    If chx = 0 Then
        NoMoreDiacritiques = txt
    Else
        NoMoreDiacritiques = IIf(chx = 1, UCase(txt), LCase(txt))
    End If
End Function
Contre toute attente, si j'écris (logiquement) :
VB:
    Tri liste3, liste1, 0, UBound(liste1)
    ComboBox1.List = liste1  'liste avec accents
les diacritique n'apparaissent pas. Je suis obligé de dupliquer le 1er array et écrire ceci :
VB:
    Tri liste3, liste2, 0, UBound(liste2)
    ComboBox1.List = liste2  'liste avec accents
et je n'arrive pas à comprendre pourquoi.
 

Pièces jointes

  • ComboBox(3).xlsm
    37 KB · Affichages: 14
Dernière édition:

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour @Magic_Doctor :),

Cela vient de votre fonction NoMoreDiacritiques(txt, Optional chx As Byte)
Il faut la déclarer NoMoreDiacritiques(byval txt, Optional chx As Byte)

Les codes suivants fonctionnent:
VB:
Private Sub UserForm_Initialize()
Dim liste1, liste2, liste3, nb%, i%
   liste1 = Array("Lézard", "Iguane", "Araignée", "Panda", "Chauve-souris", "Zèbre", "Éléphant", "Ornithorynque", "Mangouste", "Rhinocéros", "Ñandú", "Cotorra", "Gorille", "Mulita", _
                   "Kangourou", "Wallaby ", "Castor", "Tigre", "Caméléon", "Pangolin", "Ouistiti", "Vache", "Crotale", "Ragondin", "Girafe", "Léopard", "Chapon", "Kazoar", "Lion", "Guépard", _
                   "Yack", "Crapaud buffle", "Wapiti", "Quokka", "Veuve noire", "Jaguar", "Axalotl", "Xénope", "Buffle")
   ReDim liste2(LBound(liste1) To UBound(liste1))
   For i = LBound(liste1) To UBound(liste1): liste2(i) = NoMoreDiacritiques(liste1(i)): Next
   Tri liste2, liste1, LBound(liste2), UBound(liste2)
   ComboBox1.List = liste1
   ComboBox1.ListIndex = remember
End Sub

avec
Code:
Function NoMoreDiacritiques(ByVal txt, Optional chx As Byte)
Dim i&
Const AccChars = "ŠŽšžŸÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïðñòóôõöùúûüýÿ"
Const RegChars = "SZszYAAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaceeeeiiiidnooooouuuuyy"
   For i = 1 To Len(AccChars): txt = Replace(txt, Mid(AccChars, i, 1), Mid(RegChars, i, 1)): Next
   If chx = 0 Then NoMoreDiacritiques = txt Else NoMoreDiacritiques = IIf(chx = 1, UCase(txt), LCase(txt))
End Function


nota :
  • Ne pas oublier que VBA passe les arguments d'une fonction par référence (Byref) par défaut.
  • Donc si vous modifiez l'argument dans le corps de la fonction, vous modifiez aussi la variable passée en argument.
  • byval fait une copie de la variable passée en argument pour la mettre à disposition de la fonction (la fonction travaille donc sur cette copie et ne modifie pas la variable issue de la procédure appelante)
Dans votre fonction, vous modifiez txt au moyen d'une boucle. Si vous passez la variable par référence (ce qui est le cas par défaut), à la fin de la fonction, txt de la procédure appelante est forcément modifiée.

Dans la procédure appelante, vous ôtez les accents de chaque élément de liste1 et mettez le résultat dans liste2. Mais ce faisant, à chaque appel de votre de votre fonction, vous modifiez aussi l'élément de liste1. Donc à la fin du remplissage de liste2, liste1 ne contient plus d'accent (liste1 est identique à liste2). Byval corrige l'erreur.

On peut se demander pourquoi en VBA le passage par défaut des arguments à une fonction se fait par référence.



edit: bonsoir @Usine à gaz :) et bonne-nuit à @job75 🥱 et bonjour @patricktoulon 😉
 
Dernière édition:

job75

XLDnaute Barbatruc
Bonsoir Magic_Doctor, mapomme,

Tout à fait d'accord avec les explications de mapomme.

Pour mieux comprendre ajoute des MsgBox dans la macro ComboBox1_GotFocus :
VB:
    MsgBox liste1(0)
    ReDim liste3(nb - 1)
    For i = 0 To nb - 1
        liste3(i) = NoMoreDiacritiques(liste1(i))  'dresse une réplique de l'Array "Liste1" avec suppression des éventuels diacritique de tous les items
    Next
    MsgBox liste1(0)
Sans Byval liste1(0) est modifié, avec Byval il ne l'est pas.

Bonne nuit.
 

Magic_Doctor

XLDnaute Barbatruc
Bonjour mapomme, job, le forum,

Merci pour votre aide.
En effet, la nuance entre ByVal & ByRef est assez subtile (une sorte de dilemme, un peu comme le fameux "To be or not to be"...) et rarement bien expliquée (nombre de tentatives d'explications trouvées au hasard sur le net sont de véritables prises de tête pour ceux qui n'ont pas déjà compris...). Mais là, j'avoue, ça commence enfin à rentrer.
La solution de mapomme marche très bien. Pour preuve, voir la PJ.
 

Pièces jointes

  • ComboBox(4).xlsm
    29.8 KB · Affichages: 5

Magic_Doctor

XLDnaute Barbatruc
Rebonjour job,

Excellent exemple pour mieux distinguer ByVal de ByRef.
Si un argument quelconque d'une fonction est directement traité (donc modifié) dans le corps même de la fonction, il perdra sa valeur d'origine s'il est déclaré comme ByRef. Pour être préservé (l'argument toujours déclaré comme ByRef), dans le corps même de la fonction, on le subtituera par, ce que l'on pourrait appeler, son "image" qui, elle, sera la seule traitée (ici : x = txt), donc l'argument épargné. À défaut d'image, on devra le déclarer comme ByVal.
En conclusion, si une fonction qui devrait marcher renvoie un résultat inattendu, toujours vérifier comment ont été déclarés ses arguments.
 

job75

XLDnaute Barbatruc
Tu as très bien compris.

J'en profite pour souligner que la macro tri (Quick sort) a 2 arguments a et b déclarés ByRef par défaut.

Je me souviens que j'avais eu du mal à comprendre la transmission des valeurs quand je l'avais rencontrée.
 

Magic_Doctor

XLDnaute Barbatruc
Bonjour job, le forum,

De toi à moi, la macro tri, c'est pas évident. J'ai regardé un peu sur le net "QuickSort" ; c'est vraiment quelque chose qu'il faut lire à tête reposée.

La fonction "NoMoreDiacritiques" n'était évidemment pas de moi. Je l'avais trouvée sur le net (ici) et m'etais contenté de la renommer et d'y faire quelques modifications mineures (Maj / Min) dont une, croyant bien faire, qui me fut fatale.
VB:
Option Explicit
 
Function fnSupprAccents(texte As String)
 
Dim i As Long
Dim A As String, B As String, str As String
Const AccChars = "ŠŽšžŸÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïðñòóôõöùúûüýÿ"
Const RegChars = "SZszYAAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaceeeeiiiidnooooouuuuyy"
 
str = texte
For i = 1 To Len(AccChars)
    A = Mid(AccChars, i, 1)
    B = Mid(RegChars, i, 1)
    str = Replace(str, A, B)
Next
fnSupprAccents = str
 
End Function
Pour faire plus concis, j'avais viré la variable "str". Et c'est tant mieux, sinon je n'aurais toujours commencé à comprendre toutes ces nuances.
 

Discussions similaires

Statistiques des forums

Discussions
311 733
Messages
2 082 019
Membres
101 872
dernier inscrit
Colin T