Cree une mise en page à l'aide d'une feuille excel comme source

Résolu

chevalier565 Messages postés 1 Statut Membre -
Cdsj Messages postés 9 Statut Membre - 16 juin 2017 à 11:15

Bonjour

voici mon problème, j'ai un fichier excel avec une feuille ayant toutes les données sources correspondant à des chantiers. Une ligne = un chantier . un chantier peut avoir plusieurs propriétaires.
Je souhaiterai simplifier pour une meilleur visibilité lors de l'impression. Malheureusement pour moi je ne peut pas modifié la disposition des lignes ou colonnes du fichier source car il appartient à un client.

Exemple
GPS n° longueur mode de realisation Prop 1 nom Prenom Prop 2 nom Prenon
47.1251 1 25 facile ZA 1 aaa abb ZA 2 bbb Abc

pour la mise en page

N° GPS longueur Prop nom
1 47.1251 25 ZA 1 aaa
1 47.1251 25 ZA 2 bbb

Merci pour le coup de main, je suis débutant en vba, mais cela me réduirait un temps précieux
Ps; il n'y a pas toujours plusieurs propriétaires

Afficher la suite

2 réponses

Réponse 1 / 2
gbinforme Messages postés 14930 Date d'inscription Statut Contributeur Dernière intervention 4 744

Bonjour,

Un petit exemple avec tes données :

https://www.cjoint.com/c/GEliaSVaM5l

La feuille 2 se met à jour lorsque on l'active.
1

chevalier565

Bonjour
Merci beaucoup gpinforme, j'ai fait quelques modifications, et çà marche!
Je vais pouvoir gagner un temps précieux

gbinforme Messages postés 14930 Date d'inscription Statut Contributeur Dernière intervention 4 744

Bonjour, Merci du retour et bonne utilisation.
0

Cdsj Messages postés 9 Statut Membre > gbinforme Messages postés 14930 Date d'inscription Statut Contributeur Dernière intervention

Bonjour gbinforme,

je reprend la suite de chevalier565, qui travaille avec moi.
On repart du même fichier excel

Le but étant dorénavant de créer un nouvel onglet avec une ligne par nom&prénom (pour éviter les doublons) afin de créer une base de publipostage sur Word.

Si on a plusieurs fois le même nom&prénom, les infos sont concaténés sur la ligne correspondantes.

Ça j'ai réussi à le programmer, mais, il faudrait y rajouter certaines conditions.

Si une info est écrite, il ne faut pas la concaténer avec l'ensemble.

Voici mon code :

Sub DOUBLON()
    If MsgBox("Regrouper les doublons?", vbOKCancel, "Demande de Confirmation") = vbOK Then
   
    Set wsi = Worksheets(3)
    dli = wsi.Cells(Rows.Count, 15).End(xlUp).Row
    Set wso = Worksheets(4)
    dlo = 0
    rupt = ""
    For i = 1 To dli + 1
        If wsi.Cells(i, 15) <> rupt Then
            If rupt <> "" Then
                dlo = dlo + 1
                wso.Cells(dlo, 1) = str0
                wso.Cells(dlo, 2) = str1
                wso.Cells(dlo, 3) = str2
                wso.Cells(dlo, 4) = str3
                wso.Cells(dlo, 5) = str4
                wso.Cells(dlo, 6) = str5
                wso.Cells(dlo, 7) = str6
                wso.Cells(dlo, 8) = str7
                wso.Cells(dlo, 9) = str8
                wso.Cells(dlo, 10) = str9
                wso.Cells(dlo, 11) = str10
                wso.Cells(dlo, 12) = str11
                wso.Cells(dlo, 13) = str12
                wso.Cells(dlo, 14) = str13
                wso.Cells(dlo, 15) = rupt
            End If
            str0 = wsi.Cells(i, 1)
            str1 = wsi.Cells(i, 2)
            str2 = wsi.Cells(i, 3)
            str3 = wsi.Cells(i, 4)
            str4 = wsi.Cells(i, 5)
            str5 = wsi.Cells(i, 6)
            str6 = wsi.Cells(i, 7)
            str7 = wsi.Cells(i, 8)
            str8 = wsi.Cells(i, 9)
            str9 = wsi.Cells(i, 10)
            str10 = wsi.Cells(i, 11)
            str11 = wsi.Cells(i, 12)
            str12 = wsi.Cells(i, 13)
            str13 = wsi.Cells(i, 14)
            rupt = wsi.Cells(i, 15)
       
        Else
' C'est ici que je vois avoir besoin de vos conseils avisés
           str0 = str0 & " / " & wsi.Cells(i, 1)  
            str1 = str1 & " / " & wsi.Cells(i, 2)
            str2 = str2 & " / " & wsi.Cells(i, 3)
            str5 = str5 & " / " & wsi.Cells(i, 6)
            str6 = str6 & " / " & wsi.Cells(i, 7)
            str13 = str13 & " / " & wsi.Cells(i, 14)
        End If
    Next i
    wso.Columns("A:O").AutoFit
    wso.Select
         
    MsgBox (" Les doublons ont bien été supprimés !")
    MsgBox ("Attention, il ne reste plus qu'à vérifier le contenu des cellules A,B,C et F,G,H et de supprimer la dernière colonne")
   
    End If
End Sub

Les lignes sont regroupées et concaténées si les cellules de la colonne 15 sont identiques.
Je voudrais que le résultat de ces cellules ci :

            str0 = str0 & " / " & wsi.Cells(i, 1)  
            str1 = str1 & " / " & wsi.Cells(i, 2)
            str2 = str2 & " / " & wsi.Cells(i, 3)
            str5 = str5 & " / " & wsi.Cells(i, 6)
            str6 = str6 & " / " & wsi.Cells(i, 7)
            str13 = str13 & " / " & wsi.Cells(i, 14)

se fassent que lorsque le contenu est différent.

exemple
Ma base
1 2 3 ... 15
A D G ... AZ
B D H ... AZ
C F I ... AP

Ce que j'ai :
1 2 3 ... 15
A/B D/D G/H ... AZ
C F I ... AP

Ce que je voudrais :
1 2 3 ... 15
A/B D G/H ... AZ
C F I ... AP

Je ne sais pas si je suis assez clair? Merci de m'éclairer de vos lanternes.
Cordialement

gbinforme Messages postés 14930 Date d'inscription Statut Contributeur Dernière intervention 4 744

bonsoir,

On repart du même fichier excel
C'est sans doute vrai mais comme je ne l'ai jamais vu et que la description initiale était très succincte, je suis largué sur ton codage qui ne me dit pas grand chose...
Il y a plus de colonnes, la logique est différente de l'initial...
0
Cdsj Messages postés 9 Statut Membre > gbinforme Messages postés 14930 Date d'inscription Statut Contributeur Dernière intervention

Dsl, ça n'était pas clair, mais ça n'est pas grave, j'ai eu ma réponse sur une autre discussion!

Merci d'avoir pris le temps de regarder!

A une prochaine!!
0

Cdsj Messages postés 9 Statut Membre

Bon , en fait ça ne fonctionne pas suffisamment sur l'autre discussion.
Je ne vais prendre pour l'exemple que la colonne A (str0)
Je concatène avec la cellule du dessous si les cellules de la colonne 15 sont non-vide et identiques.

Sub DOUBLON()
    If MsgBox("Regrouper les doublons?", vbOKCancel, "Demande de Confirmation") = vbOK Then
   
    Set wsi = Worksheets(3)
    dli = wsi.Cells(Rows.Count, 15).End(xlUp).Row
    Set wso = Worksheets(4)
    dlo = 0
    rupt = ""
    For i = 1 To dli + 1
        If wsi.Cells(i, 15) <> rupt Then
            If rupt <> "" Then
                dlo = dlo + 1
                wso.Cells(dlo, 1) = str0
               wso.Cells(dlo, 15) = rupt
            End If
            str0 = wsi.Cells(i, 1)
            rupt = wsi.Cells(i, 15)
       
        Else
            If str0 <> wsi.Cells(i, 1) Then 'Apport de l'autre discussion que me permet de ne concaténer que les cellules différentes qui se suivent
            str0 = str0 & " / " & wsi.Cells(i, 1) 'Or Il faudrait que je puisse obtenir la concaténation des cellules différentes peut importe si elles se suivent ou pas
            End If

        End If
    Next i
    wso.Columns("A:O").AutoFit
    wso.Select
  End If
End Sub

exemple
Ca fonctionne ici :
55/55/56/57 ---> 55/56/57
Ce ne fonctionne plus ici :
55/56/57/55/57 --> 55/56/57/55/57

Newsletters