Discussion :

[Juliens06]

Bonjour à tous,

Je me permets de solliciter votre aide car je n’arrive pas à réaliser une macro permettant de répondre à mon besoin.
Je vous joins un classeur exemple.
Concrètement, chaque personne dispose de fonctions dont le nombre peut varier (dans l’exemple, 3 fonctions actuelles).
Sous chaque fonction est indiqué le nom (en colonne A), en colonne E est indiqué l’identifiant et en colonne H, la date d’effet.

Ce que je souhaiterai est crééer une macro qui arrangerait le fichier pour avoir, sur la même ligne :
- La fonction
- Le nom
- L’identifiant correspondant
- La date d’effet

Je ne sais pas comment m’y prendre sachant que ces informations ne sont pas sur le même ligne à l’origine, que le nombre de fonction peut varier et que ces informations ne sont pas toujours placées sur une ligne en particulier (dans mon exemple par exemple, la fonction 1 se retrouve en ligne 23, mais dans un autre exemple, elle peut se retrouver en ligne 25).

Pourriez-vous m’aider s’il vous plait ?

Merci par avance.

[halaster08]

Bonjour,

Une proposition sans vba, si besoin l'enregistreur de macro te donnera le code correspondant
1) Tri tes données par identifiant
2)Dans une nouvelle colonne sur la premiere ligne de données mettre la formule: =A2&";"&H2 Puis sur les lignes en dessous la formule =SI(E3=E2;I2&";"&A3&":"&H3;A3&":"&H3) Copie en valeur les résultat obtenu
Tu obtiens dans une cellule la liste des nom et date séparée par un point-virgule
3) Ajoute une colonne qui compte le nombre de caractère puis tri décroissant sur cette valeur et suppression de doublon par identifiant
Il te reste une ligne par identifiant avec toutes les infos dans une cellule
4) Utilise la fonction donnée->convertir->séparateur ;
Et voilà tu a maintenant une colonne par nom et date

[Menhir]

Personnellement, j'utiliserais simplement une fonction DECALER() avec comme décalage verticale une formule du style LIGNE()*5+COLONNE() (à ajuster en ajoutant/soustrayant une valeur fixe en fonction de la position de destination des valeurs et de la cellule de référence du DECALER).

En tout cas, c'est ce que je fais chaque fois que j'ai à réorganiser des données de ce type.

[zoltar_x]

Bonjour,

Le fichier que tu donnes est difficile à traiter parce qu'il y a beaucoup de cellules fusionnées.
Commence par enlever les cellules fusionnées et adapte ce code que j'ai testé qui remonte le nom et la référence pour les 3 fonctions.

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
 
Sub Test2()
 
    Dim plage As Range
    Dim i As Byte
    Dim ma_table()
 
    Set plage = Worksheets(1).UsedRange
    ma_table = Array("Fonction 1", "Fonction 2", "Fonction 3")
 
    For i = 0 To 2
 
        With plage
 
            Worksheets(2).Cells(i + 1, 1) = .Find(What:=ma_table(i)).Offset(rowOffset:=1) 'nom
            Worksheets(2).Cells(i + 1, 2) = .Find(What:=ma_table(i)).Offset(rowOffset:=2, columnOffset:=1) 'référence
 
        End With
 
    Next i
 
End Sub

La réorganisation par ligne se fait dans la deuxième feuille : Worksheets(2).
Le tableau donnée est supposé être dans la première feuille : Worksheets(1).

[Juliens06]

Bonjour,

Tout d'abord merci de vos réponses !
Je pense que je n'ai pas été très clair dans ma demande et je m'en excuse.
J'ai modifié mon classeur et j'ai mis sur le coté ce que je souhaiterai obtenir. Rn gros avoir un tableau avec sur une seule ligne l'ensemble des informations.

Merci beaucoup

[zoltar_x]

Maintenant que tu as enlevé les cellules fusionnées et que tu as mis le résultat final, c'est très simple.

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
 
Sub Test2()
 
    Dim plage As Range
    Dim i As Byte
    Dim ma_table()
 
    Set plage = Worksheets(1).Range("A1:H50")
    ma_table = Array("Fonction 1", "Fonction 2", "Fonction 3")
 
    For i = 0 To 2
 
        With plage
 
            Cells(i + 23, 15) = ma_table(i)
            Cells(i + 23, 16) = .Find(What:=ma_table(i)).Offset(rowOffset:=1) 'nom
            Cells(i + 23, 17) = .Find(What:=ma_table(i)).Offset(rowOffset:=2, columnOffset:=4) 'identifiant
            Cells(i + 23, 18) = .Find(What:=ma_table(i)).Offset(rowOffset:=2, columnOffset:=6) 'référence
            Cells(i + 23, 19) = .Find(What:=ma_table(i)).Offset(columnOffset:=7) 'date
 
        End With
 
    Next i
 
End Sub

Bon courage.

[Juliens06]

Super ! Merci beaucoup !
En revanche, si dans le fichier j'ai plus que 3 fonctions comment puis-je m'y prendre ? Sachant que le "fonction 1", "Fonction 2" … ont été modifiés pour l'exemple, mais en vrai, leurs noms peuvent être différents.

Merci beaucoup.

[Menhir]

Remplace le For To par :

Code :

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

    For i = LBound(ma_table) To UBound(ma_table)

Et remplie le Array avec l'ensemble de tes fonctions.

[Juliens06]

Top merci ! un problème de résolu.
J'ai encore une dernière question car le souci se présente.
Il peut arriver que les noms des fonctions soient équivalentes, c'est à dire que nous ayons "Fonction 1" plusieurs fois à la suite, mais les informations en dessous changent. Il est donc nécessaire que dans le tableau créé avec la macro, toutes "Fonction 1" ressortent à la suite.
Avec la macro fourni, il est toujours repris uniquement les données du premier champs renseigné "Fonction 1".
Y'at-t-il une solution à cela ?

Désolé si je ne suis pas très claire.

[zoltar_x]

Voilà le code pour entrer Fonction 1 ou Fonction 9999. Il suffit de mettre une * après fonction et tester qu'on ne retourne pas sur la première occurence pour éviter une boucle sans fin.

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
 
Sub test3()
 
    Dim plage As Range
    Dim occur As Range
    Dim mot As String
    Dim premier_match As String
    Dim i As Integer
 
    mot = "Fonction *"
    Set plage = Worksheets(1).Range("A1:H50")
    Set occur = plage.Find(What:=mot)
 
    With plage
 
        If Not occur Is Nothing Then
            premier_match = occur.Address
            Do
                i = i + 1
                Cells(i + 22, 15) = occur.Value 'fonction
                Cells(i + 22, 16) = occur.Offset(rowOffset:=1) 'nom
                Cells(i + 22, 17) = occur.Offset(rowOffset:=2, columnOffset:=4) 'identifiant
                Cells(i + 22, 18) = occur.Offset(rowOffset:=2, columnOffset:=6) 'référence
                Cells(i + 22, 19) = occur.Offset(columnOffset:=7) 'date
                Set occur = plage.FindNext(occur)
            Loop While Not occur Is Nothing And occur.Address <> premier_match
        End If
 
    End With
 
End Sub

[Menhir]

Il peut arriver que les noms des fonctions soient équivalentes, c'est à dire que nous ayons "Fonction 1" plusieurs fois à la suite, mais les informations en dessous changent. Il est donc nécessaire que dans le tableau créé avec la macro, toutes "Fonction 1" ressortent à la suite.
Avec la macro fourni, il est toujours repris uniquement les données du premier champs renseigné "Fonction 1".
Y'at-t-il une solution à cela ?

Oui, ça s'appelle un tableau croisé dynamique et il n'y a pas besoin de passer par du VBA pour le mettre en place.

[zoltar_x]

Voila la version simplifiée, le "With plage" est inutile ici, à la différence du premier script avec Fonction1, Fonction2 et Fonction 3 :

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
 
Sub test4()
 
    Dim plage As Range
    Dim occur As Range
    Dim mot As String
    Dim premier_match As String
    Dim i As Integer
 
    mot = "Fonction *"
    Set plage = Worksheets(1).Range("A1:H50")
    Set occur = plage.Find(What:=mot)
 
    If Not occur Is Nothing Then
        premier_match = occur.Address
        Do
            i = i + 1
            Cells(i + 22, 15) = occur.Value 'fonction
            Cells(i + 22, 16) = occur.Offset(rowOffset:=1) 'nom
            Cells(i + 22, 17) = occur.Offset(rowOffset:=2, columnOffset:=4) 'identifiant
            Cells(i + 22, 18) = occur.Offset(rowOffset:=2, columnOffset:=6) 'référence
            Cells(i + 22, 19) = occur.Offset(columnOffset:=7) 'date
            Set occur = plage.FindNext(occur)
        Loop While Not occur Is Nothing And occur.Address <> premier_match
    End If
 
End Sub

[Juliens06]

Un grand grand merci ! ça fonctionne à la perfection !