Excel - Transposer avec conditions Résolu/Fermé

Question

Bonjour, 

J'ai un petit soucis au niveau d'un tableau que je dois remplir assez souvent.
Celui-ci a des centaines de lignes, votre aide serait donc plus que la bienvenue.

J'ai une liste de personne avec leur adresse respective, en colonne, que je dois mettre en ligne. Le problème est que le nombre de ligne par personne n'est pas fixe.

Les cas possibles pour les adresses :
Pas d'adresse
1 ligne : code postale/ville
2 lignes : rue 1 et code postale/ville
3 lignes : rue 1 rue 2 et code postale/ville
il peut y avoir 3 ou 4 lignes pour les rues, alors que je ne peux en avoir que 2 au final...

http://hpics.li/558db8f

J'aimerai donc une formule ou une macro, qui me permette de transposer convenablement comme sur l'image.
Si mettre les 3/4 lignes des rues ne peut pas être ramené dans les deux disponibles, j'aimerai juste le savoir, pour pouvoir le remplir à la main. Par exemple qu'au lieu du "Tour V - Appt 1" de mon exemple, figure la mention "à remplir" ou autre phrase type....

Si déjà vous arrivez à m'aider pour la grande majorité des cas où il n'y que 2 lignes maxi pour la rue (+ cp.ville) cela m'aiderait énormément.

Merci d'avance !

Configuration: Windows 7 / Firefox 18.0

pilas31 · Accepted Answer

Bonjour,

Voici une petite macro qui fait le travail (pas trop mal).
Attention, Trois contraintes :
1/ il ne faut pas de ligne vide
2/ Si il y a une ou plusieurs lignes Adresse alors la dernière est toujours Code Postal + Ville.
3/ en colonne A il y a toujours un num pour une nouvelle personne sinon il n'y a rien

Sub Transposer()  
Nump = 2  
Lig = 2  
DerLig = Range("B" & Rows.Count).End(xlUp).Row  
While Lig <= DerLig  
    Range(Cells(Nump, 5), Cells(Nump, 10)).ClearContents  
    Cells(Nump, 5) = Cells(Lig, 1)  
    Cells(Nump, 6) = Cells(Lig, 2)  
    Lig = Lig + 1  
    LigDeb = Lig  
    While Cells(Lig, 1) = "" And Lig <= DerLig  
        Lig = Lig + 1  
    Wend  
    If Lig - 1 >= LigDeb Then  
        Cells(Nump, 9) = Left(Cells(Lig - 1, 2), 5)  
        If Len(Cells(Lig - 1, 2)) > 5 Then  
            Cells(Nump, 10) = Right(Cells(Lig - 1, 2), Len(Cells(Lig - 1, 2)) - 5)  
        End If  
    End If  
    If Lig - 1 >= LigDeb + 1 Then  
        Cells(Nump, 7) = Cells(LigDeb, 2)  
    End If  
    If Lig - 1 >= LigDeb + 2 Then  
        Cells(Nump, 8) = Cells(Lig - 2, 2)  
    End If  
    If Lig - 1 >= LigDeb + 3 Then  
        Cells(Nump, 7) = Cells(Nump, 7) & " - " & Cells(Lig - 3, 2)  
    End If  
    Nump = Nump + 1  
Wend  
End Sub

Pour aller dans l'éditeur VBA faire Alt+F11, inéserer un nouveau module, copier coller la macro et l'éxécuter

A+
Cordialement,

Ashka · Answer

Merci ! 
Merci beaucoup !
Vous venez de me faire gagner des heures de travail rébarbatif.

La macro fonctionne parfaitement et les trois contraintes sont justement celles que j'ai à la base.

Encore merci pour avoir pris du temps pour me faire cette macro très utile !