XL 2013 Transposer 3 colonnes

maval

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
Trier par date Trier par votes
D

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
 
Vote positif 0 Vote négatif
patricktoulon

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
<TABLE>
<TR>
<TD style="WIDTH: 33%; TEXT-ALIGN: center"><A class=info href=".../fiches_deputes/philippe_berta.html">philippe_berta<SPAN><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"'>
<P class=text>xxxxx<BR>xxxxxx</P></SPAN></A></TD>
<TD style="WIDTH: 33%; TEXT-ALIGN: center"><A class=info href=".../fiches_deputes/hervé_berville.html">hervé_berville<SPAN><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"'>
<P class=text>xxxxx<BR>xxxxxx</P></SPAN></A></TD>
<TD style="WIDTH: 33%; TEXT-ALIGN: center"><A class=info href=".../fiches_deputes/grégory_besson_moreau.html">grégory_besson_moreau<SPAN><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"'>
<P class=text>xxxxx<BR>xxxxxx</P></SPAN></A></TD></TR>
<TR>
<TD style="WIDTH: 33%; TEXT-ALIGN: center"><A class=info href=".../fiches_deputes/barbara_bessot.html">barbara_bessot<SPAN><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"'>
<P class=text>xxxxx<BR>xxxxxx</P></SPAN></A></TD>
<TD style="WIDTH: 33%; TEXT-ALIGN: center"><A class=info href=".../fiches_deputes/gisèle_biémouret.html">gisèle_biémouret<SPAN><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"'>
<P class=text>xxxxx<BR>xxxxxx</P></SPAN></A></TD>
<TD style="WIDTH: 33%; TEXT-ALIGN: center"><A class=info href=".../fiches_deputes/bruno_bilde.html">bruno_bilde<SPAN><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"'>
<P class=text>xxxxx<BR>xxxxxx</P></SPAN></A></TD></TR>
<TR>
Cliquez pour agrandir...
apercu dans le navigateur
demo3.gif
 
Vote positif 0 Vote négatif
patricktoulon

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
demo3.gif
 
Vote positif 0 Vote négatif
maval

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
 
Vote positif 0 Vote négatif
job75

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
Vote positif 0 Vote négatif
patricktoulon

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
 
Vote positif 0 Vote négatif

Discussions similaires

E
  • Résolu(e)
XL 2019 Remplacer une partie du code HTML par des lignes provenant d'un fichier Excel.
Réponses
12
Affichages
374
eCHO
E
T
  • Question
Autres adapter le code à Excel
Réponses
4
Affichages
897
tarouf
T
maval
  • Question
Insertion de mots dans une phrase
2
Réponses
15
Affichages
1 K
maval
maval
W
  • Question
Obtenir plusieurs informations via webpage avec une macro
Réponses
2
Affichages
997
wolfloner
W
T
  • Question
Récupérer code html des cellules d'un tableau Web vers Excel
Réponses
4
Affichages
2 K
ttlan
T
J
  • Question
Piloter une page internet a partir d'une macro qui ouvre la page en question.
Réponses
1
Affichages
1 K
jojo2909
J
S
  • Question
Erreur dans adaptation d'une macro qui marche
2
Réponses
15
Affichages
2 K
ERIC S
ERIC S
DragonBallZ1981
  • Question
Problème de formule
Réponses
7
Affichages
38 K
DragonBallZ1981
DragonBallZ1981
J
  • Question
Uploader un fichier .txt sur une page WEB via VBA
Réponses
1
Affichages
4 K
Staple1600
Staple1600
S
  • Question
Recuperation donnée hmtl spécifique sous excel
Réponses
2
Affichages
1 K
stt_stt
S

Membres actuellement en ligne

4 membres et 72 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 104
Messages
2 085 349
Membres
102 869
dernier inscrit
radyreth