Comme le dit le titre, j'aurai besoin d'une petite aide pour créer une formule matricielle :
J'ai bien lu les tutos de BOISGONTIER (super merci !!!) sur les matricielles, notamment MatBD et MatricielExtraitLangues.
En fait, mon souci est simple, en M1, j'ai une valeur, je dois chercher dans la colonne A si la valeur correspond et si oui, inscrit les valeurs B,C,etc....dans les case N,O,P, etc... voir PJ
J'ai essayé avec
Code:
=equiv($M$1;$A:$A;0)
mais je n'ai que la première ligne....
J'ai vu que les matricielles pouvaient résoudre ce problème...., que j'ai vu dans MatBD, mais que je n'arrive pas à reproduire car je ne peux nommer la plage...
Et naturellement, si la formule s'inscrivait via une macro, ce serait top du top.....
(je sais que je peux utiliser un
Code:
for i = 1 to 15
if cells(i,1)=cells(1,19) then ....
mais j'ai beaucoup de ligne et cela ralentirai le code, d'où l'idée de passer par les matricielles.....
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [M1]) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Range("N2:Q" & Rows.Count).Delete xlUp 'RAZ
If [M1] = "" Then Exit Sub
[E2] = "=A2=M$1"
[A:D].AdvancedFilter xlFilterCopy, [E1:E2], [N1:Q1]
[E2] = ""
End Sub
Merci job75,
Mais le tri n'est pas une solution que je peux retenir : en A: D j'ai déjà des formules matricielles, donc pas de tri....
c'est pourquoi je cherche une solution qui me donnerait juste les lignes où les valeurs M1 soient listées....
Le filtre avancé ne faisait aucun tri du tableau, l'avez-vous vraiment testé ?
Mais si vous tenez absolument à une formule matricielle, voyez le fichier joint avec cette macro :
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [M1]) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Range("N2:Q" & Rows.Count).Delete xlUp 'RAZ
If [M1] = "" Then Exit Sub
[A1].CurrentRegion.Offset(1).Name = "T" 'plage nommée
With [N2].Resize([T].Rows.Count, [T].Columns.Count)
.FormulaArray = "=IFERROR(INDEX(T,SMALL(IF(INDEX(T,,1)=R1C13,ROW(T)-1),ROW(T)-1),COLUMN(T)),"""")"
.Value = .Value 'facultatif, supprime les formules
End With
End Sub
Si vous voulez voir la formule, mettez en commentaire la ligne facultative.
J'oubliais que sur Excel 2003 on ne peut pas utiliser SIERREUR, il faut modifier la macro :
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [M1]) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Range("N2:Q" & Rows.Count).Delete xlUp 'RAZ
If [M1] = "" Then Exit Sub
[A1].CurrentRegion.Offset(1).Name = "T" 'plage nommée
With [N2].Resize([T].Rows.Count, [T].Columns.Count)
.FormulaArray = "=INDEX(T,SMALL(IF(INDEX(T,,1)=R1C13,ROW(T)-1),ROW(T)-1),COLUMN(T))"
.Value = .Value 'facultatif, supprime les formules
On Error Resume Next 's'il n'y a pas de constante d'erreur
.SpecialCells(xlCellTypeConstants, 16) = ""
End With
End Sub
Pour renseigner la cellule M1 voyez la ComboBox et ces macros :
Code:
Private Sub ComboBox1_GotFocus()
Dim t, d As Object, i&
t = [A1].CurrentRegion.Resize(, 2) 'au moins 2 éléments
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(t)
If t(i, 1) <> "" Then d(t(i, 1)) = ""
Next
If d.Count Then ComboBox1.List = d.keys Else ComboBox1.Clear
ComboBox1.DropDown
End Sub
Private Sub ComboBox1_Change()
[M1] = ComboBox1
Application.ScreenUpdating = False
Range("N2:Q" & Rows.Count).Delete xlUp 'RAZ
If [M1] = "" Then Exit Sub
[A1].CurrentRegion.Offset(1).Name = "T" 'plage nommée
With [N2].Resize([t].Rows.Count, [t].Columns.Count)
.FormulaArray = "=INDEX(T,SMALL(IF(INDEX(T,,1)=M1,ROW(T)-1),ROW(T)-1),COLUMN(T))"
.Value = .Value 'facultatif, supprime les formules
On Error Resume Next 's'il n'y a pas de constante d'erreur
.SpecialCells(xlCellTypeConstants, 16) = ""
.EntireColumn.AutoFit 'ajustement largeur
End With
End Sub
Avec fonction perso:
-Rapide (0,2 sec pour 10.000 lignes). Elle utilise un tableau VBA (Array)
-Utilisable comme une fonction standard sans connaître VBA
-Utilisable plusieurs fois sur la même feuille sans modifier le code.
-Pas besoin de modifier le code si on déplace des champs
-Réutilisable sans ré-écrire de code
-Pas de titre de colonnes
-1 ou 2 critère(s) de sélection et choix d'une colonne de tri
-Sélectionner N2:O22
=filtrebd(A226;1;M1;{1;2;3;4})
-Valider avec maj+ctrl+entrée
Function FiltreBD(BD As Range, colCrit1, critere1, ColResult, Optional colcrit2, Optional critere2, Optional ColTri)
(j'ai un peu honte, je n'étais pas arrivé à faire tourner votre code, et donc je "lisais" votre code et j'ai mal compris la notion de filtre...)
J'ai testé votre code et il fonctionne parfaitement, super merci.
Super merci JB, une fois de plus....
par contre, j'ai essayé de modifié votre code, afin de faire une "comparaison" entre les 2 versions : la votre et celle de job75 en terme de rapidité, mais j'ai "#Valeur" qui s'affiche....pourtant, j'ai mis la bd à jour, idem pour la formule...je ne comprends pas....
Pour tester j'ai recopié le tableau A2: D13 sur 12000 lignes.
Résultats sur Win 8 - Excel 2013 :
- fichiers des posts #6 et #8 => 4,8 secondes
- solution du post #7 de JB => 0,78 seconde.
Y a pas photo
Nota : pour tester la fonction de JB j'ai utilisé sur mon fichier :
Code:
Private Sub ComboBox1_Change()
Dim x
x = Timer
[M1] = ComboBox1
Application.ScreenUpdating = False
Range("N2:Q" & Rows.Count).Delete xlUp 'RAZ
If [M1] = "" Then Exit Sub
[A1].CurrentRegion.Offset(1).Name = "T" 'plage nommée
With [N2].Resize([t].Rows.Count, [t].Columns.Count)
.FormulaArray = "=IF(FiltreBD(T,1,M1,{1;2;3;4})=0,"""",FiltreBD(T,1,M1,{1;2;3;4}))"
.Value = .Value 'facultatif, supprime les formules
.EntireColumn.AutoFit 'ajustement largeur
End With
MsgBox Timer - x
End Sub
Il est en fait inutile de passer pas des formules matricielles.
La solution la plus simple et la plus rapide est d'utiliser des tableaux VBA dans une procédure Sub :
Code:
Private Sub ComboBox1_Change()
Dim x$, t, ncol%, i&, n&, j%
x = ComboBox1
t = [A1].CurrentRegion.Resize([A1].CurrentRegion.Rows.Count + 1)
ncol = UBound(t, 2)
If x <> "" Then
For i = 2 To UBound(t)
If t(i, 1) = x Then
n = n + 1
For j = 1 To ncol
t(n, j) = t(i, j)
Next
End If
Next
[N2].Resize(n, ncol) = t
End If
[N2].Offset(n).Resize(Rows.Count - n - 1, ncol).Delete xlUp
[N2].Resize(, ncol).EntireColumn.AutoFit
End Sub
Fichier joint.
Sur 12000 lignes la macro s'exécute en 0,13 seconde.
Effectivement, nettement plus rapide, je pensais que les boucles allaient être plus lentes, mais avec une plage, c'est vrai que 0,13s je vois difficilement comment faire plus rapide.....
en plus, le code est super beau....je suis tellement loin d'arriver à une si belle logique....mais j'essaye....