Vous utilisez un navigateur obsolète. Il se peut que ce site ou d'autres sites Web ne s'affichent pas correctement. Vous devez le mettre à jour ou utiliser un navigateur alternatif.
Boostez vos compétences Excel avec notre communauté !
Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force.
Apprenez, échangez, progressez – et tout ça gratuitement !
👉 Inscrivez-vous maintenant !
Bonjour à tous
Comment transposer les données en I4
Merci pour votre Aide
VB:
Sub transpose()
Dim WS1 As Worksheet
Set WS1 = Sheets("data for diagrams")
'Range("C32:CY32,C47:CY47,C63:CY63;C79:CY79,C95:CY95")
Dim a(1 To 5)
a(1) = WS1.Range("C32:CY32").Value
a(2) = WS1.Range("C47:CY47").Value
a(3) = WS1.Range("C63:CY63").Value
a(4) = WS1.Range("C79:CY79").Value
a(5) = WS1.Range("C95:CY95").Value
For i = 1 To 5
For j = 1 To UBound(a(i))
'If a(i)(j, 1) <> "" Then ComboBox1.AddItem a(i)(j, 1)
'If a(i)(j, 1) <> "" Then
[I4].Resize (a(i)(j, 1) = Application.transpose(a(i)(j, 1)))
Next j
Next i
End Sub
Bonjour à tous
Comment transposer les données en I4
Merci pour votre Aide
VB:
Sub transpose()
Dim WS1 As Worksheet
Set WS1 = Sheets("data for diagrams")
'Range("C32:CY32,C47:CY47,C63:CY63;C79:CY79,C95:CY95")
Dim a(1 To 5)
a(1) = WS1.Range("C32:CY32").Value
a(2) = WS1.Range("C47:CY47").Value
a(3) = WS1.Range("C63:CY63").Value
a(4) = WS1.Range("C79:CY79").Value
a(5) = WS1.Range("C95:CY95").Value
For i = 1 To 5
For j = 1 To UBound(a(i))
'If a(i)(j, 1) <> "" Then ComboBox1.AddItem a(i)(j, 1)
'If a(i)(j, 1) <> "" Then
[I4].Resize (a(i)(j, 1) = Application.transpose(a(i)(j, 1)))
Next j
Next i
End Sub
Sub essai3()
Dim WS1 As Worksheet
Set WS1 = Sheets("data for diagrams")
a = WS1.Range("C32:CY32")
b = WS1.Range("C47:CY47")
d = WS1.Range("C63:CY63")
e = WS1.Range("C79:CY79")
f = WS1.Range("C95:CY95")
c = Fusion(a, b, d, e, f)
[I5].Value = 0
[I6].Resize(UBound(c)) = c
End Sub
Function Fusion(tab1, tab2, tab3, tab4, Optional tab5)
Dim temp()
Set mondico1 = CreateObject("Scripting.Dictionary")
For Each c In tab1
If c <> "" And c <> 0 Then tmp = c: mondico1(tmp) = ""
Next c
For Each c In tab2
If c <> "" And c <> 0 Then tmp = c: mondico1(tmp) = ""
Next c
For Each c In tab3
If c <> "" And c <> 0 Then tmp = c: mondico1(tmp) = ""
Next c
For Each c In tab4
If c <> "" And c <> 0 Then tmp = c: mondico1(tmp) = ""
Next c
If Not IsMissing(tab5) Then
For Each c In tab5
If c <> "" And c <> 0 Then tmp = c: mondico1(tmp) = ""
Next c
End If
On Error Resume Next
tmp = Application.Caller.Rows.Count
If Err = 0 Then ReDim temp(1 To Application.Caller.Rows.Count) Else ReDim temp(1 To mondico1.Count)
On Error GoTo 0
i = 1
For Each c In mondico1.keys
temp(i) = c
i = i + 1
Next
Fusion = Application.transpose(temp)
End Function
Bonjour Regueiro,
Un petit fichier test aurait été le bienvenu.
En PJ une approche avec un transpose par collage, ce qui n'est guère plus long pour 5 plages, avec :
VB:
Sub Copier()
Dim WS1, L, i%
Application.ScreenUpdating = False
Set WS1 = Sheets("data for diagrams")
L = Array(32, 47, 63, 79, 95)
For i = 0 To UBound(L)
WS1.Range("C" & L(i) & ":CY" & L(i)).Copy
Cells(4, 9 + i).PasteSpecial Paste:=xlPasteValues, Transpose:=True
Next i
Application.CutCopyMode = False
[A1].Select
End Sub
Merci pour votre réponse
Je ne pouvais pas mettre de fichier pour l'instant
Fichier très lourd pour du dimensionement de poutre Métallique
avec plusieurs cas de charges.
Oups ! Pas bien compris la demande.
En PJ la même approche, il suffit de remplacer la ligne de collage avec :
VB:
Cells(4 + 101 * i, "I").PasteSpecial Paste:=xlPasteValues, Transpose:=True
Les futurs lecteurs auront ainsi deux approches.
( à noter que ( sur mon PC Win10 XL2007 ) la solution par dico prend 32ms, celle par collage 60ms donc plus lente )
Re,
"Just for the fun" un essai en PJ donnant le même temps qu'avec un dico, mais sans dico ... et une macro plus courte :
VB:
Sub Copier()
Dim WS1, L, i%
Application.ScreenUpdating = False
Set WS1 = Sheets("data for diagrams")
L = Array(32, 47, 63, 79, 95)
For i = 0 To UBound(L)
T = WS1.Range("C" & L(i) & ":CY" & L(i))
Range("I" & 4 + 101 * i & ":I" & 104 + 101 * i) = Application.Transpose(T)
Next i
End Sub
Bonsoir,
Pas avec cette méthode car un array construit de la sorte ne comporte que des valeurs.
D'ailleurs je pense que par dico, c'est la même chose.
Peut être la possibilité de rafraichir les données lors du besoin.
Merci pour ta réponse
j'ai utilisé la méthode de Boisgontier
Un peu plus fastidieux mais cela fonctionne
VB:
=fusion(TABX1;TABX2;TABX3;TABX4;TABX5)
Function Fusion(tab1, tab2, tab3, tab4, Optional tab5)
Dim temp()
Set mondico1 = CreateObject("Scripting.Dictionary")
For Each c In tab1
'If c <> "" And c <> 0 Then tmp = c: mondico1(tmp) = ""
If c <> "" Then tmp = c: mondico1(tmp) = ""
Next c
For Each c In tab2
If c <> "" Then tmp = c: mondico1(tmp) = ""
Next c
For Each c In tab3
If c <> "" Then tmp = c: mondico1(tmp) = ""
Next c
For Each c In tab4
If c <> "" Then tmp = c: mondico1(tmp) = ""
Next c
If Not IsMissing(tab5) Then
For Each c In tab5
If c <> "" Then tmp = c: mondico1(tmp) = ""
Next c
End If
On Error Resume Next
tmp = Application.Caller.Rows.Count
If Err = 0 Then ReDim temp(1 To Application.Caller.Rows.Count) Else ReDim temp(1 To mondico1.Count)
On Error GoTo 0
i = 1
For Each c In mondico1.keys
temp(i) = c
i = i + 1
Next
Fusion = Application.transpose(temp)
End Function
Bonjour,
Qu'entendiez vous par "transposer avec liaison " ?
Car votre macro transfère des valeurs, il n'y a pas de liaisons.
Par contre il supprime les valeurs vides.
Pour moi "transposer avec liaison" permet au nouveau tableau de suivre de façon dynamique les évolutions dans les 5 plages.
Re,
"Just for the fun", en PJ un copier coller avec liaison.
C'est à dire que la zone coller est dynamique et toujours l'image des plages copiées, comme le ferait à la main un copier coller avec liaisons:
N'est à exécuter qu'une seule fois puisque dynamique. Avec :
VB:
Sub CopierAvecLiaisons()
Dim WS1, L, i%, Formule$
Application.ScreenUpdating = False
Set WS1 = Sheets("data for diagrams")
L = Array(32, 47, 63, 79, 95)
For i = 0 To UBound(L)
' Définition de la plage où coller les formules
Plage = WS1.Range("$C" & L(i) & ":$CY" & L(i))
' Formule equivalant à : =INDEX('data for diagrams'!$C$32:$CY$32;1;LIGNE()-3) pour la 1ere valeur.
Formule = "=INDEX('data for diagrams'!$C$" & L(i) & ":$CY$" & L(i) & ",1,ROW()-" & 101 * i + 3 & ")"
' Collage des formules
Range("I" & 4 + 101 * i & ":I" & 104 + 101 * i).Formula = Formule
Next i
End Sub
- Navigue sans publicité - Accède à Cléa, notre assistante IA experte Excel... et pas que... - Profite de fonctionnalités exclusives Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel. Je deviens Supporter XLD
