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 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100
| Option Explicit
'---------------------------------------------------------------------------------------
' Procedure : RANGSI
' Author : Philippe BERARD
' Date : 04/04/2010
' Purpose : Largement inspirée d'un exemple disponible sur 'Developpez.com'
' (http://silkyroad.developpez.com/vba/tableaux/#LIII-B)
'---------------------------------------------------------------------------------------
'
Function RANGSI(Valeur_Rang As Long, Plage_Rang As Range, Critère, Plage_Critère As Range, Optional CouD As String)
Dim Tableau() As Long
Dim Lignes As Integer, Colonnes As Integer, y As Integer, Dim2 As Integer, Compteur As Integer, i, j
Dim indexColTri As Byte
Dim t As Variant
Dim Resultat As String
If Plage_Rang.Count <> Plage_Critère.Count Then
RANGSI = "Erreur définition Plages"
Exit Function
End If
'----- Tri décroissant par défaut -----------
If CouD = "" Then CouD = "D"
If (CouD <> "D" And CouD <> "C") Then
RANGSI = "Choisir D[écroissant] ou C[roissant]"
Exit Function
End If
'----- Chargement du tableau ----------------
For Compteur = 1 To Plage_Rang.Count
If Plage_Critère(Compteur) = Critère Then
Dim2 = Dim2 + 1
ReDim Preserve Tableau(1 To 3, 1 To Dim2)
Tableau(1, Dim2) = Plage_Rang(Compteur)
Tableau(2, Dim2) = Dim2
Tableau(3, Dim2) = 0
End If
Next
'--------------------------------------------
'---- Applique un tri sur une des colonnes du tableau -----
'Choisissez la colonne à trier: 1= 1ere colonne , 2= 2eme colonne...etc ...
indexColTri = 1
'On sort si l'index de colonne indiqué (indexColTri) est plus grand que la taille de la première
'dimension dans le tableau.
'If indexColTri > UBound(Tableau, 1) Then Exit Sub
For i = 1 To UBound(Tableau, 2) 'Lignes
For j = 1 To UBound(Tableau, 2) - 1
'---------
'syntaxe pour le tri de données type Date
'If CDate(Tableau(indexColTri, j)) > CDate(Tableau(indexColTri, j + 1)) Then
'Pensez à adapter le type de variable: Dim Tableau(1 To 4, 1 To 50) As Date
'syntaxe pour le tri de données type numérique
'If CDec(Tableau(indexColTri, j)) > CDec(Tableau(indexColTri, j + 1)) Then
'Pensez à adapter le type de variable: Dim Tableau(1 To 4, 1 To 50) As Long ...
'syntaxe pour le tri de données type Texte
If Tableau(indexColTri, j) < Tableau(indexColTri, j + 1) And CouD = "D" _
Or Tableau(indexColTri, j) > Tableau(indexColTri, j + 1) And CouD = "C" Then
'---------
For y = 1 To UBound(Tableau, 1) 'Colonnes
'Stockage temporaire de la ligne j
t = Tableau(y, j)
'La ligne j prend les valeur de la ligne suivante
Tableau(y, j) = Tableau(y, j + 1)
'La ligne suivante prend les valeur de la ligne stkée temporairement en t
Tableau(y, j + 1) = t
Next y
End If
Next j
Next i
'------------------------------------------------------------
'---------------- Rang généré en 3ème colonne ---------------
For i = 1 To UBound(Tableau, 2) 'Lignes
Tableau(3, i) = i
If Tableau(1, i) = Valeur_Rang Then RANGSI = i
Next i
'------------------------------------------------------------
'---- Affiche le résultat dans la fenêtre d'exécution -------
'For i = 1 To UBound(Tableau, 2)
' Resultat = ""
' For j = 1 To UBound(Tableau, 1)
' Resultat = Resultat & Tableau(j, i) & vbTab
' Next j
' Debug.Print Resultat
'Next i
'------------------------------------------------------------
End Function |
Partager