Pb complexe : lignes vers colonne sous condition

[excellent]

Bonjour,

J'ai un exercice qui me semble assez délicat.

Je souhaiterais transposer des lignes vers des colonnes ou plus exactement des groupes de lignes.
Chaque groupe de lignes commence par un champs en caractère gras et en majuscule. Les groupes de lignes contiennent entre 6 et 10 lignes (il n'y a donc pas le même nombre de lignes, ce qui complexifie encore le pb).

Auriez vous une idée des différentes étapes à réaliser pour arriver au résultat que je souhaite?
J'ai mis ci-joint mes données d’origines et celles attendues en résultat.

Avis aux experts!

 

[ROGER2327]

Re : Pb complexe : lignes vers colonne sous condition

Bonsoir excellent

Je ne connais pas de fonction Excel susceptible de détecter la graisse d'une fonte, donc je pense qu'une éventuelle solution passe par l'utilisation de VisualBasic. De plus, compte tenu de la structure ultra-bordélique de la feuille de données, la solution risque d'être compliquée.

Dans un premier temps, essayez le code suivant, et voyez si c'est un début valable.​

Sub toto()
Dim i&, j&, k&, SectAct&, Org As Worksheet
    Set Org = Worksheets("donnees")
    i = 1
    j = 1
    With Worksheets("resultats")
        Do Until IsEmpty(Org.Cells(i, 1))
            If Org.Cells(i, 1).Font.Bold Then
                SectAct = i
            ElseIf Left$(Org.Cells(i, 1), 2) = Chr(192) & " " Then
                j = j + 1
                Org.Cells(SectAct, 1).Copy Destination:=.Cells(j, 1)
                Org.Cells(i, 1).Copy Destination:=.Cells(j, 2)
                k = 2
            Else
                k = k + 1
                If k > 9 Then
                    .Cells(j, 9).Value = .Cells(j, 9).Value & " " & Org.Cells(i, 1).Value
                Else
                    Org.Cells(i, 1).Copy Destination:=.Cells(j, k)
                End If
            End If
            i = i + 1
        Loop
    End With
End Sub

ROGER2327
#5930

Mardi 24 Merdre 139 (Sainte Purge, sage - femme - fête Suprême Quarte)
22 Prairial An CCXX, 8,8647h - camomille
2012-W23-7T21:16:31Z

 

[CISCO]

Re : Pb complexe : lignes vers colonne sous condition

Bonjour à tous, bonjour Roger

Bonsoir excellent
Je ne connais pas de fonction Excel susceptible de détecter la graisse d'une fonte,

On peut peut être faire avec LIRE.CELLULE(20
(Si tous les caractères dans la cellule ou seul le premier caractère dans la cellule est en caractères gras, renvoie VRAI ; sinon, FAUX.)
avec peut être un problème de mise à jour automatique, comme c'est souvent le cas avec les fonctions XL4.

@ plus

 

[excellent]

Re : Pb complexe : lignes vers colonne sous condition

Bonjour et merci pour vos contributions.

Merci à vous Roger particulièrement car votre solution convient au moins pour les 5 premiers champs. Après ça se complique, en raison du fait qu'il n'y ait pas le même nombre de lignes pour chaque groupe.
Il y a donc du nettoyage à faire mais il me semble à postériori, par vérification des caractères ("04";"@";...)

Je vais y réfléchir.
Si vous avez des idées n'hésitez pas.

Bonne journée

 

[JBARBE]

Re : Pb complexe : lignes vers colonne sous condition

Bonjour,

La solution de Roger est la bonne !

Néanmoins, dans la feuille "Donnees " il faut mettre les données de la lignes 84 dans la ligne 83 > Médico-Technique) sinon il est impossible de concevoir la macro !

 

[ROGER2327]

Re : Pb complexe : lignes vers colonne sous condition

Bonsoir à tous

Peut-être un peu mieux ?​

Sub toto()
Dim i&, j&, k&, SectAct&, Org As Worksheet
    Set Org = Worksheets("donnees")
    i = 1
    j = 1
    With Worksheets("resultats")
        .Cells.Resize(.Rows.Count - 1, .Columns.Count).Offset(1).Clear
        Do Until IsEmpty(Org.Cells(i, 1))
            If Org.Cells(i, 1).Font.Bold Then
                SectAct = i
            ElseIf Left$(Org.Cells(i, 1), 2) = Chr(192) & " " Then
                j = j + 1
                Org.Cells(SectAct, 1).Copy Destination:=.Cells(j, 1)
                Org.Cells(i, 1).Copy Destination:=.Cells(j, 2)
                k = 2
            Else
                k = k + 1
                Select Case k
                Case 3, 9: Org.Cells(i, 1).Copy Destination:=.Cells(j, k)
                Case 4: If CStr(Org.Cells(i, 1).Value) Like "* *" Then Org.Cells(i, 1).Copy Destination:=.Cells(j, k) Else i = i - 1
                Case 5, 6: If CStr(Org.Cells(i, 1).Value) Like "##.##.##.*" Then Org.Cells(i, 1).Copy Destination:=.Cells(j, k) Else i = i - 1
                Case 7: If CStr(Org.Cells(i, 1).Value) Like "www.*.*" Then Org.Cells(i, 1).Copy Destination:=.Cells(j, k) Else i = i - 1
                Case 8: If CStr(Org.Cells(i, 1).Value) Like "*@*.*" Then Org.Cells(i, 1).Copy Destination:=.Cells(j, k) Else i = i - 1
                Case Else: .Cells(j, 9).Value = .Cells(j, 9).Value & " " & Org.Cells(i, 1).Value
                End Select
            End If
            i = i + 1
        Loop
        .Activate
    End With
End Sub

ROGER2327
#5932

Mercredi 25 Merdre 139 (Apparition d’Ubu Roi - fête Suprême Seconde)
23 Prairial An CCXX, 9,5420h - chèvrefeuille
2012-W24-1T22:54:03Z

 

[excellent]

Re : Pb complexe : lignes vers colonne sous condition

Bonsoir à tous

Peut-être un peu mieux ?​

Sub toto()
Dim i&, j&, k&, SectAct&, Org As Worksheet
    Set Org = Worksheets("donnees")
    i = 1
    j = 1
    With Worksheets("resultats")
        .Cells.Resize(.Rows.Count - 1, .Columns.Count).Offset(1).Clear
        Do Until IsEmpty(Org.Cells(i, 1))
            If Org.Cells(i, 1).Font.Bold Then
                SectAct = i
            ElseIf Left$(Org.Cells(i, 1), 2) = Chr(192) & " " Then
                j = j + 1
                Org.Cells(SectAct, 1).Copy Destination:=.Cells(j, 1)
                Org.Cells(i, 1).Copy Destination:=.Cells(j, 2)
                k = 2
            Else
                k = k + 1
                Select Case k
                Case 3, 9: Org.Cells(i, 1).Copy Destination:=.Cells(j, k)
                Case 4: If CStr(Org.Cells(i, 1).Value) Like "* *" Then Org.Cells(i, 1).Copy Destination:=.Cells(j, k) Else i = i - 1
                Case 5, 6: If CStr(Org.Cells(i, 1).Value) Like "##.##.##.*" Then Org.Cells(i, 1).Copy Destination:=.Cells(j, k) Else i = i - 1
                Case 7: If CStr(Org.Cells(i, 1).Value) Like "www.*.*" Then Org.Cells(i, 1).Copy Destination:=.Cells(j, k) Else i = i - 1
                Case 8: If CStr(Org.Cells(i, 1).Value) Like "*@*.*" Then Org.Cells(i, 1).Copy Destination:=.Cells(j, k) Else i = i - 1
                Case Else: .Cells(j, 9).Value = .Cells(j, 9).Value & " " & Org.Cells(i, 1).Value
                End Select
            End If
            i = i + 1
        Loop
        .Activate
    End With
End Sub

ROGER2327
#5932

Mercredi 25 Merdre 139 (Apparition d’Ubu Roi - fête Suprême Seconde)
23 Prairial An CCXX, 9,5420h - chèvrefeuille
2012-W24-1T22:54:03Z

Excellent! (c'est le cas de le dire)
C'est exactement ce que je souhaitais.
Merci beaucoup

 

[ROGER2327]

Re : Pb complexe : lignes vers colonne sous condition

Re...

(...)
C'est exactement ce que je souhaitais.
(...)

Tant mieux ! Mais restent des zones d'ombre : comment distinguer le numéro de téléphone du numéro de fax ? que signifie un champ dans lequel il y a deux numéros de téléphone ou de fax ? comment savoir si un champ écrit en gras est la suite d'un nom d'association ou un nouvel intitulé de secteur d'activité ?
Il me semble vraiment que votre fournisseur de données n'est pas très "professionnel".​

ROGER2327
#5938

Jeudi 26 Merdre 139 (Sainte Barbaque, naïade - fête Suprême Quarte)
24 Prairial An CCXX, 8,9086h - caille-lait
2012-W24-2T21:22:50Z