XL 2016 Macro pour afficher grande valeur

[guellila]

Bonjour

j'ai un tableau Excel avec deux colonnes Site A et Site B et des données de pourcentages sur la colonnes C , je cherche une macro pour remplir les cellules de la colonnes D avec le plus grand pourcentage qui corresponds au critère Site A et Site B

un exemple en attaché

 

[djidji59430]

Bonjour à tous,

pas compris grand chose, mais un essai :

 

[job75]

Bonsoir guellila, djidji59430,

Formule matricielle en C2 à valider par Ctrl+Maj+Entrée :

=MAX((A$2:A$61=A2)*(B$2:B$61=B2)*C$2:C$61)

A+

 

[djidji59430]

Je me disais bien que je n'avais rien compris !

Crdlmt

 

[guellila]

Bonsoir guellila, djidji59430,

Formule matricielle en C2 à valider par Ctrl+Maj+Entrée :

=MAX((A$2:A$61=A2)*(B$2:B$61=B2)*C$2:C$61)

A+

Bonjour
j'ai déjà travaillé avec une formule mais mon problème que je travail sur un tableau très volumineux avec plus de 450000 lignes et avec les formules c'est trop long alors je cherche une macro dans l'espoir que ca sera plus rapide

merci

 

[job75]

Vous avez tout à fait raison, les formules matricielles ne vont pas avec un grand nombre de lignes.

Alors voyez le fichier .xlsm joint et cette macro :

Sub Maximum()
Dim d As Object, tablo, i&, x$
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
With Feuil1 'CodeName de la feuille
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    With .[A1].CurrentRegion
        '---liste des maxima---
        tablo = .Resize(, 3) 'matrice, plus rapide
        For i = 2 To UBound(tablo)
            x = tablo(i, 1) & Chr(1) & tablo(i, 2)
            If tablo(i, 3) > d(x) Then d(x) = tablo(i, 3)
        Next i
        '---affectation des maxima au tableau resu---
        ReDim Resu(1 To UBound(tablo), 1 To 1)
        Resu(1, 1) = .Cells(1, 4)
        For i = 2 To UBound(tablo)
            Resu(i, 1) = d(tablo(i, 1) & Chr(1) & tablo(i, 2))
        Next
        '---restitution sur la 4ème colonne---
        .Columns(4) = Resu
    End With
End With
End Sub

Elle est très rapide car elle utilise des tableaux VBA et le Dictionary.

 

[job75]

Pour tester j'ai recopié le tableau A2: D61 sur 600 000 lignes.

On obtient un fichier de 11,6 Mo.

Chez moi sur Excel 2019 la macro s'exécute en 2,2 secondes.

 

[guellila]

Vous avez tout à fait raison, les formules matricielles ne vont pas avec un grand nombre de lignes.

Alors voyez le fichier .xlsm joint et cette macro :

Sub Maximum()
Dim d As Object, tablo, i&, x$
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
With Feuil1 'CodeName de la feuille
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    With .[A1].CurrentRegion
        '---liste des maxima---
        tablo = .Resize(, 3) 'matrice, plus rapide
        For i = 2 To UBound(tablo)
            x = tablo(i, 1) & Chr(1) & tablo(i, 2)
            d(x) = IIf(tablo(i, 3) > d(x), tablo(i, 3), d(x))
        Next i
        '---affectation des maxima au tableau resu---
        ReDim resu(1 To UBound(tablo), 1 To 1)
        resu(1, 1) = .Cells(1, 4)
        For i = 2 To UBound(tablo)
            x = tablo(i, 1) & Chr(1) & tablo(i, 2)
            resu(i, 1) = d(x)
        Next
        '---restitution sur la 4ème colonne---
        .Columns(4) = resu
    End With
End With
End Sub

Elle est très rapide car elle utilise des tableaux VBA et le Dictionary.

Bonjour
merci pour la macro
je n'est pas beaucoup de connaissance en macro , est-ce que c'est possible d'adapter votre macro a la disposition des colonnes dans le fichier en attaché

cdt

 

[job75]

Le fichier en retour avec la macro adaptée :

Sub Maximum()
Dim d As Object, tablo, i&, x$
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
With Feuil1 'CodeName de la feuille
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    With .[J1].CurrentRegion
        '---liste des maxima---
        tablo = .Resize(, 7) 'matrice, plus rapide
        For i = 2 To UBound(tablo)
            x = tablo(i, 1) & Chr(1) & tablo(i, 3)
            If tablo(i, 7) > d(x) Then d(x) = tablo(i, 7)
        Next i
        '---affectation des maxima au tableau resu---
        ReDim resu(1 To UBound(tablo), 1 To 1)
        resu(1, 1) = .Cells(1, 8)
        For i = 2 To UBound(tablo)
            resu(i, 1) = d(tablo(i, 1) & Chr(1) & tablo(i, 3))
        Next
        '---restitution sur la 4ème colonne---
        .Columns(8) = resu
    End With
End With
End Sub

J'espère que vous allez essayer de comprendre comment fonctionnent les indices des tableaux.

 

[job75]

Bonjour guellila, le forum,

Au post #6 j'ai remplacé :

d(x) = IIf(tablo(i, 3) > d(x), tablo(i, 3), d(x))

par :

If tablo(i, 3) > d(x) Then d(x) = tablo(i, 3)

Sur 600 000 lignes la durée d'exécution passe de 3,5 secondes à 2,2 secondes.

A+

 

[guellila]

bonjour

merci job75 pour la macro elle fonctionne parfaitement votre support ma été de très grande utilité merci encore une fois

cdt