Bonjour,
J’ai un tableau Excel dans lequel j’ai des noms en colonne C et des montants associés en colonne D.
Je suis parvenu à réaliser une macro pour trouver et colorer en rouge la cellule du plus petit prix correspondant à un des noms (« Raison="E" ») de la colonne D.
En revanche je ne parviens pas à développer une macro pour colorer en rouge les cellules des 4 plus petits prix correspondant à un des noms (« Raison="E" ») de la colonne D.
Merci d’avance pour votre aide.
Cordialement
Jo

Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
Sub ColorOneSmallestPricesbis()
'macro OK
    Dim rng As Range
    Dim arrPrices() As Variant
    Dim arrNames() As Variant
    Dim i As Long, j As Long, k As Long, l As Long
    Dim firstMinIndex As Long, secondMinIndex As Long
    Dim thirdMinIndex As Long, fourthMinIndex As Long
    Dim minPrice As Double
    Raison = "E"
    ' Récupérer les plages de cellules contenant les noms et les prix
    Set rng = Range("C2:C" & Range("C" & Rows.Count).End(xlUp).Row)
    Set rngPrices = Range("D2:D" & Range("D" & Rows.Count).End(xlUp).Row)
 
    ' Convertir les plages de cellules en tableaux
    arrNames = rng.Value
    arrPrices = rngPrices.Value
 
    ' Trouver le prix min pour "E"
    firstMinIndex = -1
    minPrice = -1
 
    For i = LBound(arrNames) To UBound(arrNames)
        If arrNames(i, 1) = Raison Then
            If minPrice = -1 Or arrPrices(i, 1) < minPrice Then
                minPrice = arrPrices(i, 1)
                firstMinIndex = i
 
            End If
        End If
    Next i
 
    ' Colorer les cellules correspondant au plus petits prix en rouge
    rngPrices.Cells(firstMinIndex, 1).Interior.Color = vbRed
 
End Sub
Pour la sélection de 4 cellules j'ai essayé sans succès le code suivant:
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
Sub ColorFourSmallestPrices()
'macro NOK
    Dim rng As Range
    Dim arrPrices() As Variant
    Dim arrNames() As Variant
    Dim i As Long, j As Long, k As Long, l As Long
    Dim firstMinIndex As Long, secondMinIndex As Long
    Dim thirdMinIndex As Long, fourthMinIndex As Long
    Dim minPrice As Double
    Raison = "E"
    ' Récupérer les plages de cellules contenant les noms et les prix
    Set rng = Range("C2:C" & Range("C" & Rows.Count).End(xlUp).Row)
    Set rngPrices = Range("D2:D" & Range("D" & Rows.Count).End(xlUp).Row)
 
    ' Convertir les plages de cellules en tableaux
    arrNames = rng.Value
    arrPrices = rngPrices.Value
 
    ' Trouver les quatre prix min pour "E"
    firstMinIndex = -1
    secondMinIndex = -1
    thirdMinIndex = -1
    fourthMinIndex = -1
    minPrice = -1
 
    For i = LBound(arrNames) To UBound(arrNames)
        If arrNames(i, 1) = Raison Then
            If minPrice = -1 Or arrPrices(i, 1) < minPrice Then
                minPrice = arrPrices(i, 1)
                fourthMinIndex = thirdMinIndex
                thirdMinIndex = secondMinIndex
                secondMinIndex = firstMinIndex
                firstMinIndex = i
            ElseIf arrPrices(i, 1) < arrPrices(firstMinIndex, 1) Then
                fourthMinIndex = thirdMinIndex
                thirdMinIndex = secondMinIndex
                secondMinIndex = i
            ElseIf arrPrices(i, 1) < arrPrices(secondMinIndex, 1) Then
                fourthMinIndex = thirdMinIndex
                thirdMinIndex = i
            ElseIf arrPrices(i, 1) < arrPrices(thirdMinIndex, 1) Then
                fourthMinIndex = i
            End If
        End If
    Next i
 
    ' Colorer les cellules correspondant aux quatre plus petits prix en vert
    rngPrices.Cells(firstMinIndex, 1).Interior.Color = vbGreen
    rngPrices.Cells(secondMinIndex, 1).Interior.Color = vbGreen
    rngPrices.Cells(thirdMinIndex, 1).Interior.Color = vbGreen
    rngPrices.Cells(fourthMinIndex, 1).Interior.Color = vbGreen
 
End Sub