VBA : INDEX avec MAX IF et ROW

Version imprimable

10/01/2017, 15h33
Nutella14

VBA : INDEX avec MAX IF et ROW

Salut la compagnie,

me revoila sur ce super forum car je suis encore bloqué :(

Alors voila, je dois mettre en forme un fichier et ensuite récuperer certaines valeurs, j'ai réussi la partie de la mise en forme (doublons, type, etc ...) mais il me reste la partie recherche de valeurs.

J'ai trouvé la formule en excel qui est la suivante :

=INDEX($C$1:$C$19;MAX(IF(($A$22=$A$1:$A$19)*($B$21=$G$1:$G$19);ROW($C$1:$C$19);0)))

suivi de ctrl+shift+enter

mais impossible de faire la même en vba (aide de l'enregisteur de macro aussi)

Et j'espere ne pas devoir en arriver à devoir combiner des boucle for pour les 2 conditions if, des autofilter ou autre ...

En gros l'idée (j'explique la formule ci-dessus) est de récuperer un nombre dans la colonne C. Ce nombre est récupérer si la condition 1 (ici en A22) et la condition 2 (ici en B21) sont réunis. Puis je récupére ensuite le numéro de la ligne et comme je connais déjà la colonne (la C) c'est tout bon.

Avez vous une ou plusieurs pistes pour arriver à mes fins ?

D'avance merciiiii
10/01/2017, 15h48
Marc-L

Bonjour !

Citation:

Envoyé par Nutella14

mais impossible de faire la même en vba (aide de l'enregisteur de macro aussi)

Si la formule de calculs entrée manuellement fonctionne,
il suffit de rééditer l'opération en activant au préalable l'Enregistreur de macro !

Et en cas de souci avec le code ainsi généré, conformément aux règles de ce forum, il suffit de le poster via l'icône # …

Sans compter les tutoriels dédiés aux formules en VBA !

_________________________________________________________________________________________________________
Je suis Paris, Istanbul, Berlin, Nice, Bruxelles, Charlie, …
10/01/2017, 16h07
Nutella14

je me suis mal exprimé ... j'ai bien réussi à faire l'enregistreur de macro mais le resultat ne me convient pas car je dois ensuite faire une boucle dessus (double boucle même)

Selection.FormulaArray = _
"=INDEX(R1C3:R19C3,MAX(IF((RC[-1]=R1C1:R19C1)*(R21C2=R1C7:R19C7),ROW(R1C3:R19C3),0)))"

Je dois entuite faire avancer la formule en colonne ou juste la seconde condition bouge
R21C2 / R21C3 / R21C4 ...

et en ligne ensuite
R2-1 / RC-2 ...
10/01/2017, 22h05
Nutella14

up :)

je vais essayer de redéfinir mon problème sur un exemple :

imaginons le tableau suivant :

Prenom Nom Age

Pierre X 12

Paul Y 14

Jean Z 12

Jean X 12

Pierre Y 14

Je cherche donc avoir un code me donnant selon un certain prénom et un certain nom l'âge.
Sachant que ce travail doit être fait 2 fois car la recherche sera faite pour tous les uniques prénoms il me faudra tous les âges.

Soit un tableau type suivant :

X Y Z

Pierre 12 14 0

Paul 0 14 0

Jean 12 0 12

Maintenant que la problèmatique est un peu plus clair maintenant j'espere que vous avez quelques pistes à me fournir :)

La mise en forme (récupération des prenoms unique, noms en colonne etc) a été fait, on peu condirerer que je suis avec le tableau suivant et en cellule B2 ^^

X Y Z

Pierre

Paul

Jean

Ce que je disais précédement c'est que en excel cette formule marche très bien
Selection.FormulaArray = _
"=INDEX(R1C3:R19C3,MAX(IF((RC[-1]=R1C1:R19C1)*(R21C2=R1C7:R19C7),ROW(R1C3:R19C3),0)))"

(formule extraite de l'enregistreur de macro)

mais je n'arrive pas à la faire "boucler" 2 fois pour arriver à mon résultat voulu (qui en vrai sera un peu plus tordu vu que je ne voudrai pas de 0 mais si jamais il y a un 0 alors mettre le nombre de la case précédente (à gauche), si c'est la premiere alors laisser 0, tout un programme)

D'avance merci !!!! :)

Bonjour,

Voici, si j'ai bien compris (évidemment, adapter les plages sources et destination en conséquences...)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub RecupAges()
  Dim oRangeDest As Range
  Dim oRangeSource As Range
  Dim oCellD As Range
  Dim oCellS As Range
  Dim i As Long
  'Définir la plage avec liste des prénoms du tableau final
  Set oRangeDest = Worksheets("Feuil2").Range("A2:A4")
  'Définir la plage avec liste des prénoms du tableau source
  Set oRangeSource = Worksheets("Feuil1").Range("A2:A6")
  For Each oCellD In oRangeDest
    i = 0
    For Each oCellS In oRangeSource
      If oCellD = oCellS Then
        i = i + 1
        oCellD.Offset(0, i) = oCellS.Offset(0, 2)
      End If
    Next
  Next
End Sub

Dis-nous quoi !

Tout d'abord merci beaucoup pour ta réponse ! :)

Ce code serait parfait si le tableau final ne prennait pas en compte le nom mais j'en ai besoin.

Le code actuel me donne pour chaque prénoms tous les ages possibles l'un à la suite de l'autre, et dans l'ordre dans lequel il les trouve, à savoir :

	X	Y	Z
Pierre	12	14
Paul	14
Jean	12	12

Sachant que le "1er" 12 de Jean correspond à celui de Y il me faudrait celui du X.

J'ai essayé de rajouter une seconde boucle avec les plages de noms ainsi qu'une autre condition à valider mais rien n'y fait :(

Code:

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
Sub RecupAges()
  Dim PrenomsDestination As Range
  Dim PrenomsSource As Range
  Dim NomsDestination As Range
  Dim NomsSource As Range
  Dim PCellD As Range
  Dim PCellS As Range
  Dim NCellD As Range
  Dim NCellS As Range
  Dim i As Long
  Dim p As Long
  'Définir la plage avec liste des prénoms du tableau final
  Set PrenomsDestination = Worksheets(4).Range("A6:A7")
  'Définir la plage avec liste des prénoms du tableau source
  Set PrenomsSource = Worksheets(1).Range("A2:A7500")
 
  'Définir la plage avec liste des noms du tableau final
  Set NomsDestination = Worksheets(4).Range("B5:LM5")
  'Définir la plage avec liste des noms du tableau source
  Set NomsSource = Worksheets(1).Range("G2:G7500")
 
 
  For Each PCellD In PrenomsDestination
    i = 0
  For Each NCellD In NomsDestination
     p = 0
 
    For Each PCellS In PrenomsSource
    For Each NCellS In NomsSource
      If PCellD = PCellS And NCellD = NCellS Then
        i = i + 1
        p = p + 1
        PCellD.Offset(0, i) = PCellS.Offset(0, 2)
      End If
    Next
  Next
  Next
  Next
End Sub

11/01/2017, 14h17
joe.levrai

3 pièce(s) jointe(s)

Bonjour,

pourquoi ne pas faire appel à une formule matricielle ?

Exemple présenté sur une feuille

1) Ecrire cette formule pour l'intersection Pierre / X

Code:

=SIERREUR(INDEX($A$1:$C$6;EQUIV($F2 & G$1;$A$1:$A$6 & $B$1:$B$6;0);3);0)

Matricielle : à valider par Ctrl + Maj + ENTREE

2) Etirer la formule vers le bas et vers la droite pour peupler le tableau

Pièce jointe 233665

Pièce jointe 233668

Et voilà comment on fait ça côté Excel, ne reste qu'à le faire faire par VBA :

- sortir la liste sans doublon des Prénom et Nom
- en créer le tableau de base
- injecter la formule matricielle dans la première case
- autofill les autres cases

Bonne recherche ;)

Ps : personnellement, j'ai réalisé cet exemple en partant d'un tableau structuré (listobjects en vba) ce qui me permet dans la formule d'écrire des noms de champs plutôt que des adresses, et qui est beaucoup plus pratique à manipuler en VBA

Pièce jointe 233670

Citation:

Envoyé par Nutella14

Ce code serait parfait si le tableau final ne prennait pas en compte le nom mais j'en ai besoin.

Soit, cela signifie que c'est le code qui doit établir cette liste de prénoms ?

Citation:

Envoyé par Nutella14

Sachant que le "1er" 12 de Jean correspond à celui de Y il me faudrait celui du X.

Comment sais-tu que le "1er" 12 de Jean correspond à celui de Y ? 12 ou 12, quelle différence ? Pourrais-tu préciser ?

Ensuite, si donc c'est la macro qui doit créer la liste des prénoms, ajoute le code suivant :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 Sub ListePrenoms() ' ' ListePrenoms Macro ' ' Sheets("Feuil1").Select Columns("A:A").Select Selection.Copy Sheets("Feuil2").Select Range("A1").Select ActiveSheet.Paste Application.CutCopyMode = False ActiveSheet.Range(Range("$A$1"), Range("$A$1048575").End(xlUp)).RemoveDuplicates Columns:=1, Header:=xlNo End Sub

Merci à vous deux !!

Je me dirige vers la solution de joe.levrai avec l'index + match mais j'ai un problème de syntaxe dans mon match et je tourne en rond depuis un moment.
Code:

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 Sub test() Dim colonne_solde As Range Dim colonne_prenoms As Range Dim colonne_dates As Range Dim ligne As Long Set colonne_solde = Sheets(1).Range("A2:G7500") Set colonne_prenoms = Sheets(1).Range("A:A") Set colonne_dates = Sheets(1).Range("G:G") 'prenom prenom = Sheets("Calculs").Range("A9").Value 'date dateprenoms = Sheets("Calculs").Range("B5").Value If Not IsError(Application.Match(prenom, colonne_prenoms, 0)) Then 'ligne = Application.Match(prenoms, colonne_prenoms, 0) ==> marche, me donne une chiffre 'ligne = Application.Match(CLng(dateprenoms), colonne_dates, 0) ==> marche, me donne une chiffre ligne = Application.Match(numcompte & CLng(datecompte), colonne_comptes & colonne_dates, 0) ==> "Type mismatch" MsgBox (ligne) Else MsgBox "error" End If End Sub
J'ai fais des test pour arriver peu à peu au résultat voulu avec un fois le critère du prénom ==> ok
une fois le critère de la date ==> ok
mais les deux critères ensemble j'ai un "type mismatch" et impossible de savoir ou mettre des éventuelles parenthéses ou de "" ou de & ou autre astuces :(

up :)

je reviens avec mon exemple, je n'arrive toujours pas ("Type mismatch") a faire marcher mon match avec plusieurs (2) critères.

partons du tableau suivant :

prenoms	noms	age
pierre	X	15
paul	T	16
pierre	C	17
pierre	V	18

je place en cellule E1 = "pierre" et en cellule E2 = "V"

le code suivant marche pour trouver la ligne de pierre

Code:

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
Sub testmatch()
 
 
 
Dim colonne_comptes As Range
 
 
Dim ligne As Long
 
 
Set colonne_prenoms = Sheets(6).Range("A:A")
Set colonne_noms = Sheets(6).Range("B:B")
 
 
'prenom
prenom = Sheets(6).Range("E1").Value
nom = Sheets(6).Range("E2").Value
 
If Not IsError(Application.Match(prenom, colonne_prenoms, 0)) Then
 
ligne = Application.Match(prenom, colonne_prenoms, 0)
'ligne = Application.Match(nom, colonne_noms, 0)
'ligne = Application.Match(prenom & nom, colonne_prenoms & colonne_noms, 0)
 
 
MsgBox (ligne)
Else
MsgBox "error"
End If
 
 
End Sub

j'ai bien : 2

le code suivant marche bien pour le nom

Code:

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
Sub testmatch()
 
 
 
Dim colonne_comptes As Range
 
 
Dim ligne As Long
 
 
Set colonne_prenoms = Sheets(6).Range("A:A")
Set colonne_noms = Sheets(6).Range("B:B")
 
 
'prenom
prenom = Sheets(6).Range("E1").Value
nom = Sheets(6).Range("E2").Value
 
If Not IsError(Application.Match(nom, colonne_noms, 0)) Then
 
'ligne = Application.Match(prenom, colonne_prenoms, 0)
ligne = Application.Match(nom, colonne_noms, 0)
'ligne = Application.Match(prenom & nom, colonne_prenoms & colonne_noms, 0)
 
 
MsgBox (ligne)
Else
MsgBox "error"
End If
 
 
End Sub

j'obtiens bien 5

mais ensuite pour combiner les 2 impossibles :(

Code:

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
Sub testmatch()
 
 
 
Dim colonne_comptes As Range
 
 
Dim ligne As Long
 
 
Set colonne_prenoms = Sheets(6).Range("A:A")
Set colonne_noms = Sheets(6).Range("B:B")
 
 
'prenom
prenom = Sheets(6).Range("E1").Value
nom = Sheets(6).Range("E2").Value
 
If Not IsError(Application.Match(nom, colonne_noms, 0)) Then
 
'ligne = Application.Match(prenom, colonne_prenoms, 0)
'ligne = Application.Match(nom, colonne_noms, 0)
ligne = Application.Match(prenom & nom, colonne_prenoms & colonne_noms, 0)
 
 
MsgBox (ligne)
Else
MsgBox "error"
End If
 
 
End Sub

La j'ai "Run-time error '13': Type mismatch"

Connaissez vous la syntaxe pour plusieurs critères dans un match en vba ?

D'avance merci !! :)

Bonjour,

si tu t'orientes sur un calcul des résultats en interne, il est préférable d'utiliser la puissante méthode Evaluate()

voici pour trouver le chiffre 18 qui correspond à pierre V écrit en E1-E2
Le tableau de départ est un tableau structuré (menu Insertion>>Tableau) appelé TAB_DEPART qui permet une écriture simple à comprendre de la formule

Le travail est effectué sur la feuille dont le CodeName est Feuil1
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 Sub testmatch() Dim MonTablo As ListObject, Prenom As String, Nom As String With Feuil1 Set MonTablo = .ListObjects("TAB_DEPART") Prenom = .Range("E1").Value Nom = .Range("E2").Value End With With MonTablo 'MsgBox "La Formule va être : " & "IFERROR(INDEX(" & .Range.Address & ",MATCH(""" & Prenom & Nom & """," & .ListColumns("prenoms").Range.Address & "&" & .ListColumns("noms").Range.Address & ",0)," & .ListColumns("age").Index & " ),0)" result = Evaluate("IFERROR(INDEX(" & .Range.Address & ",MATCH(""" & Prenom & Nom & """," & .ListColumns("prenoms").Range.Address & "&" & .ListColumns("noms").Range.Address & ",0)," & .ListColumns("age").Index & " ),0)") End With MsgBox "L'âge de " & Prenom & " " & Nom & " est : " & result End Sub

12/01/2017, 19h44
RyuAutodidacte

1 pièce(s) jointe(s)

Bonjour,
Avec la formule SOMMEPROD a étiré (Cf capture):

Code:

=SIERREUR(INDIRECT("C" & SOMMEPROD(($A$2:$A$6=$A11)*($B$2:$B$6=B$10)*LIGNE($C$2:$C$6)));0)

Pièce jointe 234393
13/01/2017, 10h39
Nutella14

Bonjour,

joe.levrai ton code à l'air magnifique mais j'ai un problème à la ligne 12 j'ai le message suivant :
"Subscript out of range"

Mon tableau est trop petit? je ne voie vraiment pas comment le modifier sachant que j'ai bien mis le bon nom de ma listobjects.
13/01/2017, 11h11
joe.levrai

Dans ma proposition, je manipule le ListObjects directement avec ses propriétés de "zones" (la colonne, les données du tableau etc...)

il est impossible d'avoir un problème de "Range" de cette manière

en outre, la ligne 12 étant la fermeture du bloc With, j'ai du mal à comprendre

tu peux montrer ton code et faire un print écran de ta feuille excel svp ?
13/01/2017, 11h42
Nutella14

2 pièce(s) jointe(s)

C'est la ligne 11, dsl ...

Pièce jointe 234578

Pièce jointe 234573

prenom et nom de ton fichier sont au singulier

quand tu as présenté ton tableau sur le post #10, ils étaient au pluriel, et je suis parti de ça

forcément, ça coince

soit tu renommes tes colonnes dans la feuille excel, soit tu modifies les noms de colonnes écrits dans le programme
le titre des colonnes dans excel doit être identique dans le code

sinon, l'autre solution c'est de ne pas travailler avec le "nom" des colonnes, mais avec leur "numéro de position"
Code:

1 2 3 4 5 6 7 8 9 10 11 Sub io() Dim MonTablo As ListObject Set MonTablo = ActiveSheet.ListObjects(1) ' fait référence à la première colonne ' affichera le nom de l'en tête MsgBox MonTablo.ListColumns(1) ' équivalent à MsgBox MonTablo.ListColumns("prenom") End Sub

13/01/2017, 12h27
Marc-L

:plusser:

De la rigueur, de la précision, naît le confort d'un code viable ! …

Il y a plein de méthodes pour fiabiliser l'inspection et la recherche d'un champs ... et d'agir en conséquence

un exemple simple à mettre en œuvre
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 Option Base 1 Sub io() Dim ListeChamps(), Champs ListeChamps = Array("prenom", "nom", "age", "toto") With ActiveSheet.ListObjects(1) For i = LBound(ListeChamps) To UBound(ListeChamps) Champs = Application.Match(ListeChamps(i), .HeaderRowRange, False) If IsError(Champs) Then MsgBox "Le champs " & ListeChamps(i) & " n'existe pas" Else MsgBox "Le champs " & ListeChamps(i) & " est la colonne numéro " & Champs End If Next i End With End Sub
ensuite, pour le rendre plus agile, ListeChamps doit être constitué via l'analyse de la zone d'en-tête du tableau (le HeaderRowRange)
et on met dans la procédure un tableau qui contient les champs qu'on cherche à faire Matcher

enfin, une méthode parmi des 10aines possibles, mais qui doivent être basées sur cette mécanique. Là ça dépend du contexte d'utilisation et d'agencement de ton fichier