Utilisation de Index et Match en recherche multicritères en VBA

**clem256** · 02/04/2018, 22h22

Bonjour à tous,

Je me résouds finalement à poser la question sur le forum car je bloque sur ce problème depuis deux ou trois jours sans résultats.
Je voudrais récupérer des commentaires qui se trouvent dans la colonne "Comments" d'un tableau TAB1 dans une feuille X et les mettre dans
une colonne "comments" d'un tableau TAB2 se trouvant dans une autre feuille Y. Je veux récupérer chaque commentaire en tenant compte du nom de la ressource et du projet sur lequel elle travaille. Sachant qu'une même ressource peut travailler sur deux ou n projets avec des commentaires différents associés.
Pour illustrer mon propos ci-joint un extrait de mes tableaux (en pièces jointes) et du code VBA utilisé.
Nb: les variables plages (définies en Range) étant les colones (Resource, Title, Comments) des tableaux, TAB1 et TAB2. La boucle For Each avec resName= chaque nom de la colonne Resource de TAB2

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
 
        iLoop = 1
        For Each resName In srcPlage
            projName = localwSh.Cells(iLoop + 1, colProj).Value
            On Error GoTo Err_Mngt
            retIndex = WorksheetFunction.Index(comtPlage, WorksheetFunction.Match(resName, refPlage, 0) * _
                                                WorksheetFunction.Match(projName, titlePlage, 0) - 1)
            If Not IsError(retIndex) Then
            'set the comment Name in the comment Column
                destPlage.Cells(iLoop + 1, 1) = retIndex
            Else
                GoTo Err_Mngt
            End If

Merci pour vos éclairages.

cdt
Clem256

Invité · 03/04/2018, 06h28

Envoyé par clem256

Bonjour,

A adapter et à tester :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
40
 
Option Explicit
 
Sub RecupererLesCommentairesDansTab2(ByVal AireTableau1 As Range, ByVal AireTableau2 As Range)
 
Dim CelluleTableau1 As Range, CelluleTableau2 As Range
 
    For Each CelluleTableau2 In AireTableau2
        For Each CelluleTableau1 In AireTableau1
            If CelluleTableau1 & CelluleTableau1.Offset(0, 1) = CelluleTableau2 & CelluleTableau2.Offset(0, 1) Then
                CelluleTableau2.Offset(0, 2) = CelluleTableau1.Offset(0, 2)
            End If
        Next CelluleTableau1
    Next CelluleTableau2
 
End Sub
 
Sub LancerRecupererLesCommentairesDansTab2()
 
Dim ZoneTab1 As Range, ZoneTab2 As Range
 
    On Error GoTo Fin
 
    With ActiveSheet
 
         Set ZoneTab1 = .Range("AireTab1")
         Set ZoneTab2 = .Range("AireTab2")
 
         RecupererLesCommentairesDansTab2 ZoneTab1, ZoneTab2
 
    End With
 
    GoTo Fin
 
Fin:
 
    Set ZoneTab1 = Nothing
    Set ZoneTab2 = Nothing
 
End Sub

**clem256** · 04/04/2018, 11h50

Bonjour Eric

Merci pour votre réponse rapide et votre proposition. Je n'ai pas encore essayé, mais je le ferai asap. Une remarque: je comprends que vous me déconseillez donc d'utiliser Index/match dans cette recherche?
Avec "With ActiveSheet", cela ne suppose-t-il pas que les deux tableaux TAB1 et TAB2 soient dans la même feuille? Or dans ma situation, ils se trouvent dans des feuilles différentes. Etant peu familier du "With", je suppose qu'il faudra que j'adapte cette portion de code?

Cdt

clem256

Invité · 04/04/2018, 11h59

Bonjour,

Une remarque: je comprends que vous me déconseillez donc d'utiliser Index/match dans cette recherche?

Je propose plutôt une méthode avec laquelle je suis habitué.

Avec "With ActiveSheet", cela ne suppose-t-il pas que les deux tableaux TAB1 et TAB2 soient dans la même feuille? Or dans ma situation, ils se trouvent dans des feuilles différentes., je suppose qu'il faudra que j'adapte cette portion de code?

Il suffit d'indiquer les onglets pour chaque aire.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
 
Sub LancerRecupererLesCommentairesDansTab2()
 
Dim ZoneTab1 As Range, ZoneTab2 As Range
 
    On Error GoTo Fin
 
    Set ZoneTab1 = Sheets("XXXX").Range("AireTab1")
    Set ZoneTab2 = Sheets("YYYY").Range("AireTab2")
 
   RecupererLesCommentairesDansTab2 ZoneTab1, ZoneTab2
 
    GoTo Fin
 
Fin:
 
    Set ZoneTab1 = Nothing
    Set ZoneTab2 = Nothing
 
End Sub

**clem256** · 04/04/2018, 23h25

Eric,

J'ai donc adapté le code proposé à mon application. Seulement je n'ai pas le résultat escompté. Pour le moment aucun commentaire n'est enregistré dans la colonne "Comments" de Tab2, comme si aucune correspondance n'était trouvée. Mais peut-être est-ce de ma faute. En fait les tableaux Tab1 et Tab2 de mon extrait ne sont pas exactement identiques à ceux que je teste. Les colonnes Resources, Title et Comments ne sont pas adjacentes dans mes tableaux réels. Est-ce que cela pose des problème avec l'utilisation de la propriété offset? Ce sont respectivement les colonnes 1, 3 et 11 des tableaux réels.
De plus pour éviter de parcourir le millions de ligne de la feuille (ce qui prend un certain temps, ne puis-je pas limiter les aires aux "CurrentRegion" avant d'appeler la fonction de récupération des commentaires?

Merci

Clem256

**Promethee25** · 05/04/2018, 00h39

Bonjour,

Pourquoi passes-tu par du VBA?
Tu pourrais très bien passer par une formule Excel puis écraser par valeur si c'est pour un changement à faire une seule fois.

La formule matricielle en C4 serait:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=INDEX($C$17:$C$25, MATCH(A4 & "@" & B4, $A$17:$A$25 & "@" & $B$17:$B$25, 0))

à valider par Ctrl+Maj+Entrée
Le '@' permet de bien séparer le contenu des deux colonnes dans lesquelles il faut regarder (par sécurité).
Encapsule dans un SIERREUR selon ton besoin:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=IFERROR(INDEX($C$17:$C$25,MATCH(A4&"@"&B4,$A$17:$A$25&"@"&$B$17:$B$25,0)),"")

Sinon tu peux adapter cette formule à ton code mais je ne sais pas si WorksheetFunction.Match aura un comportement automatiquement matriciel; c'est à vérifier.

Invité · 05/04/2018, 07h12

Envoyé par clem256

Est-ce que cela pose des problème avec l'utilisation de la propriété offset? Ce sont respectivement les colonnes 1, 3 et 11 des tableaux réels.
De plus pour éviter de parcourir le millions de ligne de la feuille (ce qui prend un certain temps, ne puis-je pas limiter les aires aux "CurrentRegion" avant d'appeler la fonction de récupération des commentaires?

La réponse est Oui. Il faut de plus, modifier la définition des aires pour la source et la cible.

A tester :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
40
41
42
43
44
45
46
 
Option Explicit
 
Sub RecupererLesCommentairesDansTab2(ByVal AireTableau1 As Range, ByVal AireTableau2 As Range)
 
Dim CelluleTableau1 As Range, CelluleTableau2 As Range
 
    For Each CelluleTableau2 In AireTableau2
        For Each CelluleTableau1 In AireTableau1
            If CelluleTableau1 & CelluleTableau1.Offset(0, 2) = CelluleTableau2 & CelluleTableau2.Offset(0, 2) Then
                CelluleTableau2.Offset(0, 10) = CelluleTableau1.Offset(0, 10)
            End If
        Next CelluleTableau1
    Next CelluleTableau2
 
End Sub
 
Sub LancerRecupererLesCommentairesDansTab2()
 
Dim ZoneTab1 As Range, ZoneTab2 As Range
Dim LigneTitreTab1 As Long, DerniereLigneTab1 As Long, LigneTitreTab2 As Long, DerniereLigneTab2 As Long
 
    On Error GoTo Fin
 
    With Sheets("Source Tab1")
         LigneTitreTab1 = 1
         DerniereLigneTab1 = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
         Set ZoneTab1 = .Range(.Cells(LigneTitreTab1 + 1, 1), .Cells(DerniereLigneTab1, 1))
    End With
 
    With Sheets("Cible Tab2")
         LigneTitreTab2 = 1
         DerniereLigneTab2 = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
         Set ZoneTab2 = .Range(.Cells(LigneTitreTab2 + 1, 1), .Cells(DerniereLigneTab2, 1))
    End With
 
    RecupererLesCommentairesDansTab2 ZoneTab1, ZoneTab2
 
    GoTo Fin
 
Fin:
 
    Set ZoneTab1 = Nothing
    Set ZoneTab2 = Nothing
 
End Sub

Bonjour Promethee25 : Toutes les solutions sont les bienvenues et si une solution est possible sans VBA, alors tu as raison, il vaut mieux l'utiliser. Cependant, chacun répond avec ce qu'il maîtrise, l'important restant l'efficacité.

**Promethee25** · 05/04/2018, 07h36

Bonjour Eric,

Bien sûr, pas de souci.
Ma question ne s'adressait pas à toi mais à Clem256; n'y vois aucune critique de ma part mais juste la volonté de comprendre les raisons du choix qu'il a fait par rapport à son besoin qui, peut-être mais sans l'affirmer, pourrait être résolu sans VBA.

Edit: en me relisant, c'est vrai que mon post n'était pas suffisamment clair et prêtait à interprétation, désolé.

**clem256** · 05/04/2018, 11h43

Bonjour

Merci à vous deux, Eric et Promethee25 pour vos conseils et propositions. J'avais continué à travailler hier soir, for tard, sur le sujet et j'ai réussi à faire fonctionner le Code VBA avant les dernières indications d'Eric que je vais tester. je pense qu'il me faut approfondir l'utilisation de Range et offset. J'ai deux remarques: à l'exécution de la double boucle For Each..Next, l'écran est bloqué pendant presque 2 minutes avant d'avoir de nouveau la main sous l'application Excel (les tableaux n'ont que 220 lignes environ..). Y-a-t-il une instruction particulière à insérer pour éviter cela? Quand j'ai la main mes ascenceurs, vertical et horizontal, ont disparu da la feuille destination, mais j'ai les commentaires

@Promethee25: j'utilse VBA parce que l'application en développement est en VBA. J'avais déjà utilisé l'expression Matricielle de Index/Match sous Excel et cela fonctionnait bien. Merci pour le tip pour "@" je ne connaissais pas.

Clem256

Invité · 05/04/2018, 11h56

Envoyé par clem256

à l'exécution de la double boucle For Each..Next, l'écran est bloqué pendant presque 2 minutes avant d'avoir de nouveau la main sous l'application Excel (les tableaux n'ont que 220 lignes environ..). Y-a-t-il une instruction particulière à insérer pour éviter cela?

Voir ce post lenteur-execution-code

S'il y a beaucoup de formules, le principe est de bloquer le recalcul provisoirement et de bloquer le rafraîchissement de l'écran. Il suffit d'encadrer le code avec :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    ' .....    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

Quant à :

Quand j'ai la main mes ascenceurs, vertical et horizontal, ont disparu da la feuille destination, mais j'ai les commentaires

Je ne vois pas d'où cela peut venir. Il faudrait voir ton code.

**clem256** · 09/04/2018, 14h20

Bonjour Eric

Pour les ascenceurs on oublie.
Quelle portion de code doit être encadrée par ces instructions:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    ' .....Boucle For Each    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

car en encadrant la boucle For Each externe avec elles, cela ne fonctionne pas mieux.
Merci
Clem256

Invité · 09/04/2018, 14h43

Envoyé par clem256

Bonjour,

Par exemple comme ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
 
Sub LancerRecupererLesCommentairesDansTab2()
 
Dim ZoneTab1 As Range, ZoneTab2 As Range
Dim LigneTitreTab1 As Long, DerniereLigneTab1 As Long, LigneTitreTab2 As Long, DerniereLigneTab2 As Long
 
    On Error GoTo Fin
 
    With Sheets("Source Tab1")
         LigneTitreTab1 = 1
         DerniereLigneTab1 = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
         Set ZoneTab1 = .Range(.Cells(LigneTitreTab1 + 1, 1), .Cells(DerniereLigneTab1, 1))
    End With
 
    With Sheets("Cible Tab2")
         LigneTitreTab2 = 1
         DerniereLigneTab2 = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
         Set ZoneTab2 = .Range(.Cells(LigneTitreTab2 + 1, 1), .Cells(DerniereLigneTab2, 1))
    End With
 
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
 
    RecupererLesCommentairesDansTab2 ZoneTab1, ZoneTab2
 
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
 
    GoTo Fin
 
Fin:
 
    Set ZoneTab1 = Nothing
    Set ZoneTab2 = Nothing
 
End Sub

Combien y a-t-il de lignes dans les boucles ?

**clem256** · 10/04/2018, 10h35

Bonjour

Il y a 220 lignes dans l'un et 230 lignes dans l'autre.

Clem256

Invité · 10/04/2018, 10h43

Envoyé par clem256

Bonjour,

C'est rien du tout. Tu as toujours ces problèmes de lenteur malgré ces lignes ?

**clem256** · 10/04/2018, 17h01

Bonjour

oui j'ai regardé ce matin. le problème de blocage de l'écran pour l'application Excel existe toujours. Il doit y avaoir un truc trop évident que j'ai oublié. Mais sinon le reste fonctione très bien. Il ne me reste qu'à faire une gestion d'erreur plus fine pour sécuriser le fonctionnement. Merci pour tes conseils et propositions de code. Et aussi merci à Promethee-25.

Clem256

Invité · 10/04/2018, 17h08

Envoyé par clem256

As-tu des macros événementielles dans ton fichier ou dans les fichiers impactés par ton code ?

Si oui, il te faut les neutraliser provisoirement :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
40
41
42
 
Sub LancerRecupererLesCommentairesDansTab2()
 
Dim ZoneTab1 As Range, ZoneTab2 As Range
Dim LigneTitreTab1 As Long, DerniereLigneTab1 As Long, LigneTitreTab2 As Long, DerniereLigneTab2 As Long
 
    On Error GoTo Fin
 
    Application.EnableEvents = False
 
    With Sheets("Source Tab1")
         LigneTitreTab1 = 1
         DerniereLigneTab1 = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
         Set ZoneTab1 = .Range(.Cells(LigneTitreTab1 + 1, 1), .Cells(DerniereLigneTab1, 1))
    End With
 
    With Sheets("Cible Tab2")
         LigneTitreTab2 = 1
         DerniereLigneTab2 = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
         Set ZoneTab2 = .Range(.Cells(LigneTitreTab2 + 1, 1), .Cells(DerniereLigneTab2, 1))
    End With
 
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
 
 
 
    RecupererLesCommentairesDansTab2 ZoneTab1, ZoneTab2
 
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
 
    Application.EnableEvents = True
 
    GoTo Fin
 
Fin:
 
    Set ZoneTab1 = Nothing
    Set ZoneTab2 = Nothing
 
End Sub

**clem256** · 12/04/2018, 11h27

Bonjour
Non je ne pense pas. Aucune instruction (pour le moment) pour gestion des événements. Tout est séquentiel dans le code qui de plus ne traite que des données se trouvant dans ce même fichier.

Invité · 12/04/2018, 11h35

Envoyé par clem256

Bonjour,

Alors je ne vois pas.

**clem256** · 12/04/2018, 12h02

Non mais je vais me plonger un peu dans la relecture du code. L'important était que je récupère les commentaires et c'est fait. Donc je vais considérer le point comme résolu. Juste pour info, il faut dire que mes tableaux "Source Tab1e et "Cible Tab2" sont respectivement des variables définies par le Name Manger Excel come
='Last Report-View'!$B:$L et =shReportTest!$B:$L

Voici le code utilisé à partir de tes suggestions (j'ai déplacé le retour en mode calcul automatique sous l'étiquette Fin, car quand j'avais une erreur dans les fonctions, l'option calcul manuel restait pour le fichier).

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
 
        On Error GoTo Fin
        Sheets(prevReport).Activate
        lnFin = Range("AireTab1").Cells(Rows.Count, 1).End(xlUp).Row
        lastCol = Range("AireTab1").Columns.Count
        Set ZoneTab1 = Range("AireTab1").Range(Cells(2, 1), Cells(lnFin, lastCol))
        'Debug.Print "Nbre Colonnes ZoneTab1 = " & ZoneTab1.Columns.Count
 
        Sheets(shTest).Activate
        lnFin = Range("AireTab2").Cells(Rows.Count, 1).End(xlUp).Row
        Set ZoneTab2 = Range("AireTab2").Range(Cells(2, 1), Cells(lnFin, lastCol))
        'Debug.Print "Nbre Colonnes ZoneTab2 = " & ZoneTab2.Columns.Count
 
        Application.ScreenUpdating = False
        Application.Calculation = xlCalculationManual
 
        RecupererLesCommentairesDansTab2 ZoneTab1, ZoneTab2

Merci.

Invité · 12/04/2018, 12h10

Envoyé par clem256

Ton problème vient des aires que tu as prises en compte, c'est énorme. Il faut que tu limites ton nombre de lignes.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
='Last Report-View'!$B:$L et =shReportTest!$B:$L

Pour récupérer ta dernière ligne,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 
With Sheets("XXXX")
          DerniereLigne = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
End With

Utilisation de Index et Match en recherche multicritères en VBA [XL-2016]

Macros et VBA Excel

Discussions similaires

Partager

Partager