VBA Pointeur - Recherche Données dans une plage

**Coxtox** · 24/04/2015, 10h52

Bonjour à tous,

Je vais essayer de vous expliquer mon problème en étant le plus synthétique possible, n'hésitez pas à me dire si ce n'est pas clair.

J'ai placé en PJ un extrait de mon fichier Excel pour que ce soit plus compréhensible.

Tout d'abord la première feuille "Atteinte Norme" contient les différents métiers avec les normes à atteindre, ..., le pourcentage de personnes atteignant la norme (valeurs que je souhaite importer dans la seconde feuille).

La seconde feuille 'Synthèse Atteinte Norme' contient les différents métiers de mon périmètre dans la première colonne, le nombre de personne dans la deuxième et les différents indicateurs dans les colonnes suivantes.
Ces métiers ne sont pas fixes il change selon la sélection de l'utilisateur.

Pour chaque métier apparaissant dans "Synthèse Atteinte Norme", je souhaite importer la valeur (pourcentage de personnes atteignant la norme) de l'indicateur correspondant (situé dans "Atteinte norme").

J'ai essayé de procéder en faisant des pointeurs mais je ne pense pas que ce soit la solution optimale ... vu que j'ai 18 indicateurs. Je me retrouve avec 4 pointeurs pour importer les valeurs d'un indicateur.

Voici l'extrait de mon code qui ne marche pas d'ailleurs ...

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
   Sub pointeur()
 
    Dim pointeur As Range
    Dim pointeur2 As Range
    Dim pointeur3 As Range
    Dim pointeur4 As Range
    Dim ligne As Integer
 
 
'positionnement du pointeur
Set pointeur = Sheets("Atteinte Norme").Range("A2")
Set pointeur3 = Sheets("Synthèse Atteinte Norme").Range("A3")
Set pointeur4 = Sheets("Synthèse Atteinte Norme").Range("C3")
 
 
   'tant que c'est pas la derniere ligne des métiers de "Atteinte Norme"
    While pointeur.Row < pointeur.SpecialCells(xlCellTypeLastCell).Row
        Set pointeur3 = Sheets("Synthèse Atteinte Norme").Range("A3")
        Set pointeur = pointeur.Offset(4, 0)
        Set pointeur2 = pointeur.Offset(3, 2)
 
           'tant que c'est pas la derniere ligne des métiers de "Synthèse Atteinte Norme"
            While pointeur3.Row < pointeur3.SpecialCells(xlCellTypeLastCell).Row
 
    If pointeur.Value = pointeur3.Value Then
    pointeur4.Value = pointeur2.Value
    Set pointeur4 = pointeur4.Offset(1, 0)
 
    Else
    Set pointeur3 = pointeur3.Offset(1, 0)
 
    End If
 
    Wend
 
    Wend
 
 End Sub

Si vous voyez une alternative à ces pointeurs qui serait plus simple je suis preneur.

Je re précise que les métiers affichés sont dynamiques. Si la sélection du périmètre change .. il se peut que des métiers ne soit plus dans se périmètre .. l'ordre se modifie.

Merci par avance,

Cordialement

**Thautheme** · 25/04/2015, 11h00

Bonjour Coxtox, bonjour le forum,

Peut-être comme ça :

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
Public Sub Macro1()
Dim AN As Worksheet 'déclare la variable AN (onglet Atteinte Norme)
Dim SAN As Worksheet 'déclare la variable SAN (onglet Synthèse Atteinte Norme)
Dim PL As Range 'déclare la variable PL (PLage)
Dim CEL As Range 'déclare la variable CEL (CELlule)
Dim R As Range 'déclare la variable R (Recherche)
 
Set AN = Sheets("Atteinte Norme") 'définit l'onglet AN
Set SAN = Sheets("Synthèse Atteinte Norme") 'définit l'onglet SAN
If SAN.Range("A3") <> "" Then Exit Sub 'si la cellule A3 de l'onglet SAN est vide, sort de la procédure
Set PL = SAN.Range("A3:A" & SAN.Range("A22").End(xlUp).Row) 'définit la plage PL
For Each CEL In PL 'boucle sur toutes les cellules CEl de la plage PL
   'définit la recherche R (recherche la valeur entière de CEL dans la colonne 1 de l'onglet AN)
   Set R = AN.Columns(1).Find(CEL.Value, , xlValues, xlWhole)
   'si il existe au moins une occurrence trouvée, renvoie dans CEL décalée de deux colonnes à droite,
   'la valeur de R décalée de trois lignes en dessous et deux colonnes à droite
   If Not R Is Nothing Then CEL.Offset(0, 2).Value = R.Offset(3, 2).Value
   Set R = Nothing 'vide la variable R
Next CEL 'prochine cellule de la boucle
End Sub

**Coxtox** · 27/04/2015, 16h39

Salut Thautheme,

Merci pour ta réponse détaillée !

J'ai testé le code que tu m'as passé, cependant lorsque j’exécute la macro rien ne se passe ...

J'ai pensé que ça pouvait venir d'un changement de format entre les libellés de métiers des deux onglets mais apparemment non
J'avais également des fusions sur les métiers de l'onglet "Atteinte Norme" que j'ai supprimé en pensant que ça jouait sur le décalage ... Toujours pas

Cependant ton code était bien plus clair.

J'ai placé en PJ le fichier avec la macro test et les différentes valeurs que devraient importer la macro..

Je ne vois pas d'où provient l'erreur !

Merci par avance !

Cordialement