Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2013 Transposer 3 colonnes

maval

XLDnaute Barbatruc
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
 

Pièces jointes

  • transpose.xlsm
    12.5 KB · Affichages: 10

danielco

XLDnaute Accro
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

XLDnaute Barbatruc
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
apercu dans le navigateur
 

patricktoulon

XLDnaute Barbatruc
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

XLDnaute Barbatruc
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>&nbsp;</td>à chaque ligne manquant je ne sais se que tu en pense?


Merci
 

job75

XLDnaute Barbatruc
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+
 

Pièces jointes

  • transpose(1).xlsm
    25.3 KB · Affichages: 8

patricktoulon

XLDnaute Barbatruc
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
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…