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

Magic_Doctor · 9 Juin 2021

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.

job75 · 11 Juin 2021

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 <=...

ChTi160 · 12 Juin 2021

Bonjour
Mdr !
Bonne journée
Merci!
Jean marie

dysorthographie · 12 Juin 2021

Bonjour,
@patrick je n'es pas trouvé sur internet d'information du le proccess du on error, mais dans mes souvenirs seule la dernière instance reste en même et le nombre de cycles machine et ridicule au vue d'un test conventionnel!

Si vous trouvez l'info ça serait intéressant.

patricktoulon · 12 Juin 2021

re
discussion dépacée

XL 2013 - connaitre le type de variable tableau un ou 2 dim et le sens

Bonjour a tous je cherche un moyen efficace de savoir quelle est le type de variable tableau une ou deux dim et est une ligne ou une colonne sans avoir a gérer des erreurs dans un sens ou dans l'autre @Yeahou a donné un début de piste interessant mais c'est pas full right Sub testy7() a =...

www.excel-downloads.com

patricktoulon · 12 Juin 2021

re
@Robert "cc'"
err.clear shunte l'erreur mais la gestion d'erreur reste ouverte
on error goto 0 ferme la gestion d'erreur mais le stack (tampon)reste avec jusqu’à fin de macro

eriiic · 12 Juin 2021

Bonjour à tous,

Patrick, tu as On Error Goto -1 pour réinitialiser le gestionnaire d'erreur.
Si tu as moyen de contrôler la pile dans ce cas (?)
eric

Bernard_XLD · 12 Juin 2021

Bonjour le fil le forum

patricktoulon à dit:
@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 · 12 Juin 2021

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 · 21 Juin 2021

job75 à dit:

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

job75 à dit:

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.

mapomme · 21 Juin 2021

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

job75 · 21 Juin 2021

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 · 22 Juin 2021

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.

job75 · 22 Juin 2021

Bonjour Magic_Doctor, le forum,

Note qu'on peut se passer de Byval.

Il suffit dans la fonction de ne pas modifier la variable txt et d'utiliser x = txt

A+

Magic_Doctor · 22 Juin 2021

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 · 22 Juin 2021

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 · 29 Juin 2021

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.

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

Magic_Doctor

XLDnaute Barbatruc

job75

ChTi160

XLDnaute Barbatruc

dysorthographie

XLDnaute Accro

patricktoulon

XLDnaute Barbatruc

XL 2013 - connaitre le type de variable tableau un ou 2 dim et le sens

patricktoulon

XLDnaute Barbatruc

eriiic

XLDnaute Barbatruc

Bernard_XLD

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Magic_Doctor

XLDnaute Barbatruc

Pièces jointes

mapomme

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Magic_Doctor

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

Magic_Doctor

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Magic_Doctor

XLDnaute Barbatruc

Discussions similaires