Discussion :

[clem256]

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é]

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]

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é]

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]

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]

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é]

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é.