XL 2013 Transposer 3 colonnes

maval · 30 Août 2019

Bonjour

J'ai sur 3 colonnes des noms que je transpose en formule.

Code:

=SI(ESTVIDE(A18);"";"<td width=""33%"" align=""center"" ><a class=""info""  href=""../fiches_deputes/"&B18&".html""> "&A18&" <span><img class=""photo"" src=""../portraits/"&C18&".jpg"" width=""120"" height=""150"" border=""0"" /><P class=""text"">xxxxx<br/>xxxxxxx</P></span></a></td>")

J'aimerai modifier comme ceci soit en formule soit en macro

Et j'aimerai avoir ceci:

VB:

<tr>
<td width="33%" align="center" ><a class="info"  href="../fiches_deputes/ian_boucard.html"> M. Ian Boucard <span><img class="photo" src="../portraits/ian boucard.jpg" width="120" height="150" border="0" /><P class="text">xxxxx<br/>xxxxxxx</P></span></a></td>
<td width="33%" align="center" ><a class="info"  href="../fiches_deputes/jean_claude_bouchet.html"> M. Jean-Claude Bouchet <span><img class="photo" src="../portraits/jean-claude bouchet.jpg" width="120" height="150" border="0" /><P class="text">xxxxx<br/>xxxxxxx</P></span></a></td>
<td width="33%" align="center" ><a class="info"  href="../fiches_deputes/florent_boudié.html"> M. Florent Boudié <span><img class="photo" src="../portraits/florent boudié.jpg" width="120" height="150" border="0" /><P class="text">xxxxx<br/>xxxxxxx</P></span></a></td>
</tr>

Je joins mon fichier qui seras plus explicite

Merci d'avance

Max

danielco · 1 Septembre 2019

Bonjour,

Désolé, il faut juste la supprimer. Ce n'est pas une erreur, mais une aide à la mise au point :

VB:

Sub test1()
  Dim Ligne As Long, Ctr As Long, Deb As Long, Tabl(), Plage As Range, C As Range, Ctr1 As Long
  Deb = Cells(1, 1).End(xlDown).Row
  Set Plage = Range("A" & Deb, Cells(Rows.Count, 1).End(xlUp)).Offset(, 6)
  Ctr = -1
  Ctr1 = 0
  Ctr = Ctr + 1
  ReDim Preserve Tabl(Ctr)
  Tabl(Ctr) = "<tr>"
  For Each C In Plage
    If Ctr1 = 2 Then
      Ctr = Ctr + 1
      ReDim Preserve Tabl(Ctr)
      Ctr1 = Ctr1 + 1
      Tabl(Ctr) = C.Value
      Ctr = Ctr + 1
      ReDim Preserve Tabl(Ctr)
      Tabl(Ctr) = "</tr>"
      Ctr = Ctr + 1
      ReDim Preserve Tabl(Ctr)
      Tabl(Ctr) = "<tr>"
      Ctr1 = 0
    Else
      Ctr = Ctr + 1
      Ctr1 = Ctr1 + 1
      ReDim Preserve Tabl(Ctr)
      Tabl(Ctr) = C.Value
    End If
  Next C
  If Ctr1 <> 0 Then
      Ctr = Ctr + 1
      ReDim Preserve Tabl(Ctr)
      Tabl(Ctr) = "</tr>"
  Else
    Tabl(Ctr) = ""
  End If
  Cells.ClearContents
  Cells(Deb, 7).Resize(UBound(Tabl)) = Application.Transpose(Tabl)
End Sub

[EDIT]En outre, j'efface toute la feuille. Je peux facilement effacer seulement les colonnes A, B et C.[/EDIT]

Daniel

patricktoulon · 1 Septembre 2019

salut
du code html ca se travaille en dom html 😉
si ca t’intéresse
tu constatera vu le résultât que de tout façon tes lignes de code n’auraient pas été valides pour aucun doctypehtml😉

VB:

Sub test()
    Dim hdoc As Object, table As Object, tr As Object, td As Object, img As Object, a As Object, span As Object, p As Object, x As Long, i As Long
    Set hdoc = CreateObject("htmlfile")
    Set table = hdoc.createelement("table"): hdoc.body.appendchild (table)
    Set tr = hdoc.createelement("TR"): table.appendchild (tr)

    For i = 5 To Cells(Rows.Count, "A").End(xlUp).Row
        x = x + 1
        Set td = hdoc.createelement("TD")
        With td.Style: .Width = "33%": .textalign = "center": End With
        Set a = hdoc.createelement("a"): td.appendchild (a)
        a.classname = "info"
        a.href = ".../fiches_deputes/" & Range("B" & i) & ".html"
        a.innerhtml = Range("A" & i)
        Set span = hdoc.createelement("span")
        Set img = hdoc.createelement("img"): span.appendchild (img)
        img.classname = "photo"
        img.src = "src=""../portraits/" & Range("B" & i) & ".jpg"""
        img.Style.Width = "120": img.Style.Height = "150": img.Style.Border = "0"
        Set p = hdoc.createelement("p"): p.classname = "text": p.innerhtml = "xxxxx<br/>xxxxxx"
        span.appendchild (p)
        a.appendchild (span)
        tr.appendchild (td)
        If x = 3 Then x = 0: Set tr = hdoc.createelement("TR"): table.appendchild (tr)
    Next
    Debug.Print hdoc.body.innerhtml
End Sub

appercu du code html obtenu

<TABLE>
<TR>
<TD style="WIDTH: 33%; TEXT-ALIGN: center"><A class=info href=".../fiches_deputes/philippe_berta.html">philippe_berta<IMG class=photo style="BORDER-TOP: 0px; HEIGHT: 150px; BORDER-RIGHT: 0px; WIDTH: 120px; BORDER-BOTTOM: 0px; BORDER-LEFT: 0px" src='src="../portraits/philippe_berta.jpg"'>
xxxxx xxxxxx</A></TD>
<TD style="WIDTH: 33%; TEXT-ALIGN: center"><A class=info href=".../fiches_deputes/hervé_berville.html">hervé_berville<IMG class=photo style="BORDER-TOP: 0px; HEIGHT: 150px; BORDER-RIGHT: 0px; WIDTH: 120px; BORDER-BOTTOM: 0px; BORDER-LEFT: 0px" src='src="../portraits/hervé_berville.jpg"'>
xxxxx xxxxxx</A></TD>
<TD style="WIDTH: 33%; TEXT-ALIGN: center"><A class=info href=".../fiches_deputes/grégory_besson_moreau.html">grégory_besson_moreau<IMG class=photo style="BORDER-TOP: 0px; HEIGHT: 150px; BORDER-RIGHT: 0px; WIDTH: 120px; BORDER-BOTTOM: 0px; BORDER-LEFT: 0px" src='src="../portraits/grégory_besson_moreau.jpg"'>
xxxxx xxxxxx</A></TD></TR>
<TR>
<TD style="WIDTH: 33%; TEXT-ALIGN: center"><A class=info href=".../fiches_deputes/barbara_bessot.html">barbara_bessot<IMG class=photo style="BORDER-TOP: 0px; HEIGHT: 150px; BORDER-RIGHT: 0px; WIDTH: 120px; BORDER-BOTTOM: 0px; BORDER-LEFT: 0px" src='src="../portraits/barbara_bessot.jpg"'>
xxxxx xxxxxx</A></TD>
<TD style="WIDTH: 33%; TEXT-ALIGN: center"><A class=info href=".../fiches_deputes/gisèle_biémouret.html">gisèle_biémouret<IMG class=photo style="BORDER-TOP: 0px; HEIGHT: 150px; BORDER-RIGHT: 0px; WIDTH: 120px; BORDER-BOTTOM: 0px; BORDER-LEFT: 0px" src='src="../portraits/gisèle_biémouret.jpg"'>
xxxxx xxxxxx</A></TD>
<TD style="WIDTH: 33%; TEXT-ALIGN: center"><A class=info href=".../fiches_deputes/bruno_bilde.html">bruno_bilde<IMG class=photo style="BORDER-TOP: 0px; HEIGHT: 150px; BORDER-RIGHT: 0px; WIDTH: 120px; BORDER-BOTTOM: 0px; BORDER-LEFT: 0px" src='src="../portraits/bruno_bilde.jpg"'>
xxxxx xxxxxx</A></TD></TR>
<TR>

apercu dans le navigateur

maval · 1 Septembre 2019

Bonjour Patrick

Je te remercie mais des message d'erreur sur le code
"Le type ne correspond pas"
sur la ligne
Set table = hdoc.createelement("table"): hdoc.body.appendchild (table)

Merci

patricktoulon · 1 Septembre 2019

re
a bon? il doit y avoir un autre code car table est bien un object un htmlelement pour être précis
il est bien déclaré donc je ne vois pas pourquoi
bon ben on les type pas alors

VB:

Sub test()
    Dim hdoc, table, tr, td, img, a, span, p, x As Long, i As Long
    Set hdoc = CreateObject("htmlfile")
    Set table = hdoc.createelement("table"): hdoc.body.appendchild (table)
    Set tr = hdoc.createelement("TR"): table.appendchild (tr)

    For i = 5 To Cells(Rows.Count, "A").End(xlUp).Row
        x = x + 1
        Set td = hdoc.createelement("TD")
        With td.Style: .Width = "33%": .textalign = "center": End With
        Set a = hdoc.createelement("a"): td.appendchild (a)
        a.classname = "info"
        a.href = ".../fiches_deputes/" & Range("B" & i) & ".html"
        a.innerhtml = Range("A" & i)
        Set span = hdoc.createelement("span")
        Set img = hdoc.createelement("img"): span.appendchild (img)
        img.classname = "photo"
        img.src = "src=""../portraits/" & Range("B" & i) & ".jpg"""
        img.Style.Width = "120": img.Style.Height = "150": img.Style.Border = "0"
        Set p = hdoc.createelement("p"): p.classname = "text": p.innerhtml = "xxxxx<br/>xxxxxx"
        span.appendchild (p)
        a.appendchild (span)
        tr.appendchild (td)
        If x = 3 Then x = 0: Set tr = hdoc.createelement("TR"): table.appendchild (tr)
    Next
    texte = Replace(table.innerhtml, "</TR>", vbCrLf & "</TR>")
    texte = Replace(texte, vbCrLf & "<P class=", "<P class=")
    tablo = Split(texte, vbCrLf)
Cells(5, 7).Resize(UBound(tablo), 1) = Application.Transpose(tablo)
End Sub

resultat

maval · 1 Septembre 2019

Re Patrick,

Oui sa fonctionne ou je ne comprend pas ces pourquoi les TR TD TEXT-ALIGN A SPAN ect... sont en majuscule ?

Et a la fin du code qu'il y a 1, 2 ou 3 ligne il devrais avoir un </tr> et moi javais mis si cela était pas complet (3 lignes) je m'était ceci <td> </td>à chaque ligne manquant je ne sais se que tu en pense?

Merci

job75 · 1 Septembre 2019

Bonjour les amis,

Je ne comprends pas du tout ce que vous faites, surtout patricktoulon et ses html !!!

Moi d'après le fichier du post #1 je comprends ceci qui est classique et pas très compliqué :

VB:

Sub Inserer()
Grouper 'RAZ
Dim deb As Range, pas&, ncol%, f$, tablo, ub&, resu(), n&, i&, j&, k%
Set deb = [A5] 'à adapter
pas = 3 'à adapter
ncol = 6 'à adapter
f = deb(1, ncol).FormulaR1C1 'surtout ne pas effacer la formule en F5...
tablo = deb.CurrentRegion.Resize(, ncol)
ub = UBound(tablo)
ReDim resu(1 To ub + 2 * (1 + Int(ub / pas)), 1 To ncol)
n = 1
For i = 1 To ub Step pas
    resu(n, ncol) = "<tr>"
    For j = 1 To pas
        If i + j - 1 > ub Then Exit For
        For k = 1 To ncol - 1
            resu(n + j, k) = tablo(i + j - 1, k)
        Next k
        resu(n + j, k) = f
    Next j
    resu(n + j, ncol) = "</tr>"
    n = n + j + 1
Next i
deb.Resize(n - 1, ncol).FormulaR1C1 = resu 'restitution
End Sub

Sub Grouper()
Application.ScreenUpdating = False
On Error Resume Next 'si aucune SpecialCell
With Columns("F")
    .Replace "<*>", "#N/A", xlWhole
    .SpecialCells(xlCellTypeConstants, 16).EntireRow.Delete
End With
End Sub

Fichier joint.

A+

patricktoulon · 1 Septembre 2019

re
il n'y a rien compliqué
tu construit un code html tu utilise les outils pour ça et pas une formule la moindre modif a faire sera un casse tete

les balises sont en majuscules parce qu'il sont créé dans un htmldocument virtuel ,et cet object n'a pas changer d'un yotat depuis IE 9
ca n'a aucune importance

VB:

Sub testx()
    Dim hdoc, table, tr, td, img, a, span, p, x As Long, i As Long
    Set hdoc = CreateObject("htmlfile")
    Set table = hdoc.createelement("table"): hdoc.body.appendchild (table)
    Set tr = hdoc.createelement("TR"): table.appendchild (tr)

    For i = 5 To Cells(Rows.Count, "A").End(xlUp).Row
        x = x + 1
        Set td = hdoc.createelement("TD")
        With td: .Width = "33%": .Align = "center": End With
        Set a = hdoc.createelement("a"): td.appendchild (a)
        a.classname = "info"
        a.href = ".../fiches_deputes/" & Range("B" & i) & ".html"
        a.innerhtml = Range("A" & i)
        Set span = hdoc.createelement("span")
        Set img = hdoc.createelement("img"): span.appendchild (img)
        img.classname = "photo"
        img.src = "src=""../portraits/" & Range("B" & i) & ".jpg"""
        img.Style.Width = "120": img.Style.Height = "150": img.Style.Border = "0"
        Set p = hdoc.createelement("p"): p.classname = "text": p.innerhtml = "xxxxx<br/>xxxxxx"
        span.appendchild (p)
        a.appendchild (span)
        tr.appendchild (td)
        If x = 3 Then x = 0: Set tr = hdoc.createelement("TR"): table.appendchild (tr)
    Next
    texte = Replace(table.innerhtml, "</TR>", "</TR>" & vbCrLf)
texte = Replace(texte, vbCrLf & "<P class", "<P class")
tablo = Split(texte, vbCrLf)
Cells(5, "F").Resize(UBound(tablo), 1) = Application.Transpose(tablo)
End Sub

maval · 1 Septembre 2019

Bonjour Job

Rien à dire à part NICKEL comme dab.

Merci et bonne journée

Max

Effectuez une recherche sur Excel Downloads...

XL 2013 Transposer 3 colonnes

maval

XLDnaute Barbatruc

Pièces jointes

danielco

XLDnaute Accro

patricktoulon

XLDnaute Barbatruc

maval

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

maval

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Pièces jointes

patricktoulon

XLDnaute Barbatruc

maval

XLDnaute Barbatruc

Discussions similaires

Nous accordons de l'importance à votre vie privée