XL 2019 je recherche une solution par vba

[ilien09]

bonjour pourrais tu stp me refaire la formule ci jointe pour la remettre dans le fichier ci joint
j'ai mis une place pour le bouton j'ai écris (pour le bouton)
merci pour ton aide et ta patience
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim A() As Variant 'déclare la variable A (taleau TOCA)
Dim B() As Variant 'déclare la variable B (tableau TOCB)
Dim X() As Variant 'déclare la variable X (Tableau TOCX)
Dim IA As Integer 'déclare la variable IA (Incrément A)
Dim IB As Integer 'déclare la variable IB (Incrément B)
Dim IX As Integer 'déclare la variable IX (Incrément X)
Dim T1 As Variant 'déclare la variable T1 (variable Temporaire 1)
Dim T2 As Variant 'déclare la variable T2 (variable Temporaire 2)

Set O = Worksheets("Feuil1") 'définit l'onglet O
TV = O.Range("A2").CurrentRegion 'définit la tableau des valeurs TV
O.Range("C14:I16").ClearContents 'effaceles anciennes données
For J = 2 To 15 'boucle sur les colonne 2 à 15
Select Case TV(3, J) 'agit en fonction de la donnée ligne 3 colonne J du tableau des valeurs TV
Case Is < 20 'cas inférieur à 20
If TV(3, J) > 6 Then 'condition : si TV(3,J) est supérieur à 6
ReDim Preserve A(1 To 2, 0 To IA) 'redimensionne le tableau A (2 lignes, IA colonnes)
A(1, IA) = TV(2, J) 'récupère le [Nº] dans la ligne 1 de A
A(2, IA) = TV(3, J) 'récupère la [COTES] dans la ligne 2 de A
IA = IA + 1 'incrémente IA
End If 'fin de la condition
Case Is < 31 'cas inférieur à 31
If TV(3, J) > 20 Then 'condition : si TV(3,J) est supérieur à 20
ReDim Preserve B(1 To 2, 0 To IB) 'redimensionne le tableau B (2 lignes, IA colonnes)
B(1, IB) = TV(2, J) 'récupère le [Nº] dans la ligne 1 de B
B(2, IB) = TV(3, J) 'récupère la [COTES] dans la ligne 2 de B
IB = IB + 1 'incrémente IB
End If 'fin de la condition
Case Is > 31 'cas supérieur à 31
ReDim Preserve X(1 To 2, 0 To IX) 'redimensionne le tableau X (2 lignes, IA colonnes)
X(1, IX) = TV(2, J) 'récupère le [Nº] dans la ligne 1 de X
X(2, IX) = TV(3, J) 'récupère la [COTES] dans la ligne 2 de X
IX = IX + 1 'incrémente IX
End Select 'fin de l'action en fonction de la donnée ligne 3 colonne J du tableau des valeurs TV
Next J 'prochaine colonne de la boucle
If IA > 0 Then 'condition : si IA est positive
For I = 0 To UBound(A, 2) 'boucle 1 : sur tous les éléments I du tableau A
For J = 0 To UBound(A, 2) 'boucle 2 : sur tous les éléments J du tableau A
If I <> J And A(2, I) < A(2, J) Then 'si I est différent de J et la cote de A(I) est inférieure à la cote de A(J)
T1 = A(1, I): A(1, I) = A(1, J): A(1, J) = T1 'tri des données
T2 = A(2, I): A(2, I) = A(2, J): A(2, J) = T2 'tri des données
End If 'fin de la condition
Next J 'prochain élément de la boucle 2
Next I 'prochain élément de la boucle 1
O.Range("C14").Resize(1, UBound(A, 2) + 1).Value = Application.Index(A, 1) 'renvoie dans C14 redimensionnée la ligne 1 de A
End If 'fin de la condition
If IB > 0 Then 'idem IA
For I = 0 To UBound(B, 2)
For J = 0 To UBound(B, 2)
If I <> J And B(2, I) < B(2, J) Then
T1 = B(1, I): B(1, I) = B(1, J): B(1, J) = T1
T2 = B(2, I): B(2, I) = B(2, J): B(2, J) = T2
End If
Next J
Next I
O.Range("C15").Resize(1, UBound(B, 2) + 1).Value = Application.Index(B, 1)
End If
If IX > 0 Then 'idem IA
For I = 0 To UBound(X, 2)
For J = 0 To UBound(X, 2)
If I <> J And X(2, I) < X(2, J) Then
T1 = X(1, I): X(1, I) = X(1, J): X(1, J) = T1
T2 = X(2, I): X(2, I) = X(2, J): X(2, J) = T2
End If
Next J
Next I
O.Range("C16").Resize(1, UBound(X, 2) + 1).Value = Application.Index(X, 1)
End If
End Sub
Haut

 

[ChTi160]

Bonjour ilien09
peut etre en simplifiant ainsi（pas d ordi ）

 Select Case True
           Case TV(3, J) > 6 And TV(3, J) ＜20 
'Code
            Case TV(3, J) > 20 And TV(3, J) ＜31
 'Code
               Case TV(3, J) > 31
'Code
End Select

jean marie

 

[ilien09]

merci mais je ne sais pas utiliser vba
vous pourriez me le faire svp