XL 2016 VBA utilisation de références structurées dans formules matricielles

[CarvaX]

Bonjour à tous,

Malgré bien des recherches sur ce forum et d'autres, impossible de trouver une réponse à mon problème qui en condense plusieurs:
J'ai un tableau avec des formules matricielles, faisant appel à d'autres colonnes, avec des formules de ce type:

{=MAX(SI([ColonneA]=[@ColonneA];[ColonneB];""))}

(Colonne A a des valeurs de 1 à 3, je veux les 3 valeurs maximales de Colonne B en colonneC)

ColonneA	ColonneB	ColonneC
1	12	14
1	12.3	14
1	14	14
2	11	12
2	12	12
3	10.5	15
3	15	15

Comment le transcrire en VBA? Sachant qu'il y a plusieurs points "sensibles":
- les guillemets
- les références structurées
- la formule matricielle

Merci pour votre aide!

 

[job75]

Bonsoir CarvaX, bienvenue sur XLD,

S'il n'y a qu'un seul tableau structuré dans la feuille exécutez cette macro :

Sub a()
With ActiveSheet.ListObjects(1).Range 'tableau structuré
    .Columns(3).Offset(1) = "" 'RAZ
    .Cells(2, 3).FormulaArray = "=MAX(IF([" & .Cells(1) & "]=[@" & .Cells(1) & "],[" & .Cells(1, 2) & "]))"
End With
End Sub

Elle fonctionne quelles que soient les en-têtes des colonnes.

Notez que dans la formule il n'y a pas besoin de guillemets.

Bonne nuit.

 

[job75]

Bonjour le forum,

Cela dit sur un grand tableau les formules matricielles prennent beaucoup de temps.

Voyez le fichier joint de 35 000 lignes et comparez ces 2 macros :

Sub Formule()
Dim t#
t = Timer
With ActiveSheet.ListObjects(1).Range 'tableau structuré
    .Columns(3).Offset(1) = "" 'RAZ
    .Cells(2, 3).FormulaArray = "=MAX(IF([" & .Cells(1) & "]=[@" & .Cells(1) & "],[" & .Cells(1, 2) & "]))"
End With
[H3] = Format(Timer - t, "0.00 \s")
MsgBox "Durée " & [H3]
End Sub

Sub Tableaux_VBA()
Dim t#, d As Object, tablo, resu(), i&, x$, y, n&
t = Timer
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée (si textes)
With ActiveSheet.ListObjects(1).Range 'tableau structuré
    tablo = .Resize(, 2) 'matrice, plus rapide
    ReDim resu(1 To UBound(tablo), 1 To 1)
    resu(1, 1) = .Cells(1, 3) 'en-tête
    For i = 2 To UBound(tablo)
        x = CStr(tablo(i, 1)): y = tablo(i, 2)
        If Not d.exists(x) Then d(x) = i 'mémorise la ligne
        If IsNumeric(y) Then n = d(x): If CDbl(y) > resu(n, 1) Then resu(n, 1) = CDbl(y)
    Next
    For i = 2 To UBound(tablo)
        resu(i, 1) = resu(d(CStr(tablo(i, 1))), 1)
    Next
    '---restitution---
    .Columns(3) = resu
End With
[H6] = Format(Timer - t, "0.00 \s")
MsgBox "Durée " & [H6]
End Sub

Avec des tableaux VBA et le Dictionary c'est toujours très rapide.

Bon dimanche.

 

[CarvaX]

Merci

pour ces deux excellentes propositions!
En revanche je reste perplexe:
- la première solution est effectivement longue en temps de calcul (ton fichier Max(1) est éloquent!), et par ailleurs je suis incapable de la faire s’exécuter sur mon tableau de travail: la colonne se remplit bien, avec...des 0 uniquement (alors que Tableaux_VBA fonctionne parfaitement)
- mais elle a le mérite de transposer de manière assez identique la structure et les commandes de ma formule. Ce qui n'est pas le cas de la solution avec tableau VBA et matrice, qui demande de repenser ce que l'on veut faire faire à la formule. or j'ai 8 colonnes avec des formules de ce type (voire plus complexes!) à transcrire...

Je vais continuer à creuser de mon côté, mais si vous avez des compléments je suis preneur!
encore merci