XL 2016 Macro pour afficher grande valeur

guellila · 21 Décembre 2020

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 · 21 Décembre 2020

Bonjour à tous,

pas compris grand chose, mais un essai :

job75 · 21 Décembre 2020

Bonsoir guellila, djidji59430,

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

Code:

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

A+

djidji59430 · 21 Décembre 2020

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

Crdlmt

guellila · 21 Décembre 2020

job75 à dit:
Bonsoir guellila, djidji59430,

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

Code:

=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 · 21 Décembre 2020

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 :

VB:

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 · 21 Décembre 2020

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 · 21 Décembre 2020

job75 à dit:

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 :

VB:

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 · 21 Décembre 2020

Le fichier en retour avec la macro adaptée :

Code:

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 · 22 Décembre 2020

Bonjour guellila, le forum,

Au post #6 j'ai remplacé :

VB:

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

par :

VB:

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 · 22 Décembre 2020

bonjour

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

cdt

XL 2016 Macro pour afficher grande valeur

guellila

XLDnaute Junior

Pièces jointes

djidji59430

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

djidji59430

XLDnaute Barbatruc

guellila

XLDnaute Junior

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

guellila

XLDnaute Junior

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

guellila

XLDnaute Junior

Discussions similaires