Ajout et tri croissant/decroissant de valeurs dans un tableau

Soyez le premier à donner votre avis sur cette source.

Snippet vu 15 808 fois - Téléchargée 28 fois

Contenu du snippet

Ce code récupére un tableau , une valeur à ajouter et la taille du tableau,
deux procédures sont proposées une trie dans l'ordre croissant, l'autre décroissant.
Elles renvoient le tableau pour la suite du traitement.

NB: les commentaires dans le code sont nombreux pour expliquer au - initiés.

Source / Exemple :


'&&&&&&    ajoute une valeur et tri la liste dans l'ordre croissant

Sub ajoucroissant_dans_liste(tabl(), valajout, tailletabl)
 Dim i, j As Integer
   'parcours toutes les valeurs du tableau "tabl"
   For i = 1 To tailletabl
   'si la valeur a ajouter est > a une des valeurs du tableau tabl
    If valajout < tabl(i) Then
      'augmente la taille du tableau de 1
     tailletabl = tailletabl + 1: ReDim Preserve tabl(tailletabl)
     'permute les valeur du tabkleau "tabl" de -1
     For j = tailletabl To i + 1 Step -1
      tabl(j) = tabl(j - 1)
     Next j
     'inscrit la valeur à sa place
     tabl(i) = valajout
     Exit Sub
    End If
    'verifie si la valeur trouvée est déja dans le tableau si oui sortir
    If tabl(i) = valajout Then Exit Sub
   Next i
   ' si fin de tableau et pas trouvé c'est une valeur <a toutes les autres valeurs du tableau
    tailletabl = tailletabl + 1: ReDim Preserve tabl(tailletabl)
    tabl(i) = valajout
End Sub

'&&&&&&& ajoute une valeur et tri la liste dans l'ordre decroissant

Sub ajoudecroissant_dans_liste(tabl(), valajout, tailletabl)
 Dim i, j As Integer
   'parcours toutes les valeurs du tableau "tabl"
   For i = 1 To tailletabl
   'si la valeur a ajouter est > a une des valeurs du tableau tabl
    If valajout > tabl(i) Then
      'augmente la taille du tableau de 1
     tailletabl = tailletabl + 1: ReDim Preserve tabl(tailletabl)
     'permute les valeur du tabkleau "tabl" de -1
     For j = tailletabl To i + 1 Step -1
      tabl(j) = tabl(j - 1)
     Next j
     'inscrit la valeur à sa place
     tabl(i) = valajout
     Exit Sub
    End If
    'verifie si la valeur trouvée est déja dans le tableau si oui sortir
    If tabl(i) = valajout Then Exit Sub
   Next i
   ' si fin de tableau et pas trouvé c'est une valeur <a toutes les autres valeurs du tableau
    tailletabl = tailletabl + 1: ReDim Preserve tabl(tailletabl)
    tabl(i) = valajout
End Sub

A voir également

Ajouter un commentaire

Commentaires

Renfield
Messages postés
17283
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
21 juillet 2019
56 -
Attention !! tes boucles commencent a 1, alors que bien souvent, les tableaux commencent a 0....

d'autre part, il existe deux fonctions pour recuperer le premier, et le dernier indice..... tu pourrais donc te passer de demander la taille...
et mettre :

For i = LBound ( tabl ) To UBound ( tabl )

enfin, vu les faibles differences entres ces deux fonctions, tu pourrais ne faire qu'une fonction, avec un parametre specifiant l'ordre du tri...

tu pourrais effectuer la même chose pour autoriser - ou non les doublons que tu héradiques systématiquement...
rnosat
Messages postés
132
Date d'inscription
mardi 31 octobre 2000
Statut
Membre
Dernière intervention
2 mai 2004
-
pas héradique , mais ERADIQUE !
Renfield
Messages postés
17283
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
21 juillet 2019
56 -
lol.

ca va, si la seule chose qui te "choques" dans mes paroles sont les fautes d'orthographe...!!
cs_Syborg
Messages postés
4
Date d'inscription
jeudi 21 août 2003
Statut
Membre
Dernière intervention
19 novembre 2003
-
Option Base 1

pour que vos structures commencent toujours à 1

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.