Microsoft 365 Modif code VBA pour rangVBA

titooooo

XLDnaute Occasionnel
j'ai pu dénicher sur le forum ce code qui fait un rang décroissant

je veux avoir la même chose mais a l'inverse

exemple ce code me sort par exemple

valeur432
rang123
voile ce que je veux

valeur432
rang321

VB:
Option Explicit

Function RangUniqueSi(Valeur As Range, PlageValeurs As Range, ValeurCondition As Range, PlageConditions As Range)
Dim tval, tcond, i&, n&, ival&, ech As Boolean, aux

   ' Vérification des arguments de la fonction
   If PlageValeurs.Count <> PlageConditions.Count Then RangUniqueSi = CVErr(xlErrRef): Exit Function
   If PlageValeurs.Columns.Count <> 1 Or PlageConditions.Columns.Count <> 1 Then RangUniqueSi = CVErr(xlErrRef): Exit Function
   If PlageValeurs.Row <> PlageConditions.Row Then RangUniqueSi = CVErr(xlErrRef): Exit Function
   If Valeur.Count <> 1 Then RangUniqueSi = CVErr(xlErrRef): Exit Function
   If Intersect(Valeur, PlageValeurs) Is Nothing Then RangUniqueSi = CVErr(xlErrRef): Exit Function

   ' Lecture des tableaux des valeurs et des conditions
   tval = PlageValeurs: tcond = PlageConditions

   ' Tableau t des valeurs (colonne2) avec leur rang d'apparition (colonne 1) pour la condition vérifiée
   ReDim t(1 To UBound(tval), 1 To 2): n = 0
   For i = 1 To UBound(tval)
      If tcond(i, 1) = ValeurCondition Then: n = n + 1: t(n, 1) = n: t(n, 2) = tval(i, 1)
   Next i

   ' Tri du tableau suivant la clef CA (colonne 2)
   Do
      ech = False
      For i = 1 To n - 1
         If t(i, 2) < t(i + 1, 2) Then
            ech = True
            aux = t(i, 1): t(i, 1) = t(i + 1, 1): t(i + 1, 1) = aux
            aux = t(i, 2): t(i, 2) = t(i + 1, 2): t(i + 1, 2) = aux
         End If
      Next i
   Loop Until Not ech

   ' Calcul du rang d'apparition de Valeur pour la région en paramètre
   ival = Application.CountIf(PlageConditions.Resize(Valeur.Row - PlageValeurs.Row + 1), ValeurCondition)

   ' On recherche le rang d'apparition ival dans le tableau trié t
   ' quand on l'a trouvé, son rang est la valeur i à retourner
   For i = 1 To n
      If t(i, 1) = ival Then RangUniqueSi = i: Exit Function
   Next i
End Function
 

Discussions similaires

Réponses
6
Affichages
202

Statistiques des forums

Discussions
311 724
Messages
2 081 936
Membres
101 844
dernier inscrit
pktla