EXCEL transposer quand grande taille tableau

weo -  
michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   -
Bonjour,
Je dois transposer une base de données. Je veux pourvoir changer les données, donc je souhaite avoir une liaison.
J'ai évidemment pensé à TRANSPOSE, mais il faut pour cela connaitre la taille du resultat.

par exemple, si je veux transposer

1 5 7
2 3 6

je dois selectionner un ensemble de cellulesde dimension 3*2

cela est plus compliqué quand la taille de ma matrice est plutot de l'orde 360*487 car du coup c'est compliqué au départ de selectionner directement la bonne taille.

je ne sais pas si je suis clair....
merci d'avance de votre aide!
A voir également:

5 réponses

manet61 Messages postés 211 Statut Membre 179
 
Bonjour,

Voici un exemple qui marche jusqu'à Excel 2003 (après je n'ai pas)

http://www.cijoint.fr/cjlink.php?file=cj200903/cij9jMnz2f.xls

A+
0
michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 318
 
Bonjour,

cette macro te fait la transposition sans le souci (pas mince vu tes dimensions) de sélectionner les zones "depart" et "but"
seule condition il doit y a avoir un espace vide autour du tableau de départ (ligne et colonne)

les constantes (const) doivent être paramétrées à tes données
à adapter à XL2007

Const cel_dep As String = "A1"
Const cel_but As String = "B2"
Const sh_dep As String = "feuil1"
Const sh_but As String = "feuil2"
'
Sub big_transpose()
Dim lig As Long, cptr2 As Long
Dim col As Long, cptr1 As Long

Application.ScreenUpdating = False

tablo = Sheets(sh_dep).Range(cel_dep).CurrentRegion

Sheets(sh_but).Activate
    lig = Range(cel_but).Row - 1
    col = Range(cel_but).Column - 1
    For cptr1 = 1 To UBound(tablo, 1)
        For cptr2 = 1 To UBound(tablo, 2)
            Cells(lig + cptr2, col + cptr1) = tablo(cptr1, cptr2)
        Next cptr2
    Next cptr1
    
End Sub


0
Zayneb_chan
 
Salut michel_m,
est ce que je peux appliquer cette macro à mon tableau:


Saison 85-1984 86-1985 87-1986
Herbicides doubles actions 130650 104700 115700
Herbicides antidycotylédones 151600 140900 213600
Total 282250 245600 329300

c'est juste un échantillon, l'original( ce que je veux transposer) est de 1985 jusqu'à 2009.
Aidez moi svp!
Merci d'avance.
0
michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 318
 
Bonjour,

apparemment, oui, sans les étiquettes ( pas sûr de moi) et en vérifiant les totaux

fais des essais sur une copie de classeur avec des tailles réduites et regarde si OK
0
lermite222 Messages postés 9042 Statut Contributeur 1 191
 
Bonjour,
Pourquoi ne pas utiliser la fonction transpose d'Excel..
Fonctionne sur le 2000 et 2007
Adapter les noms des feuilles et plage de cellules.
Sub CopieTransposee() 
    Sheets("Feuil1").Range("B3:L36").Copy 
    Sheets("Feuil3").Range("B3").PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _ 
        , Transpose:=True 
End Sub

Si tu sélectionne les sommes et les titres ils sont transposés correctement.
Si tu ne veux que les valeurs, remplacer XlAll par XlValue
A+
Toute la connaissance du monde ne peu tenir dans une seul tête (moi)
Si tu te cognes à un pot et que ça sonne creux, c'est pas forcément le pot qui est vide. ;-)(Confucius)
NOTE : Je ne répond pas aux MP pour les questions techniques.
0
gbinforme Messages postés 15481 Date d'inscription   Statut Contributeur Dernière intervention   4 730
 
bonjour à tous,

donc je souhaite avoir une liaison. a demandé weo alors je vous propose cette macro qui crée la liaison entre les 2 plages :

Sub Copie_liaison()
Dim dep As Range
Dim but As Range
Dim lgd As Long, lgb As Long
Dim cld As Long, clb As Long
Set dep = Sheets("Feuil3").Range("A1")  ' début plage à transposer
Set but = Sheets("Feuil2").Range("B15") ' début plage transposée
For lgd = dep.Row To dep.Offset(Columns(1).Cells.Count - dep.Row).End(xlUp).Row
    lgb = 0
    For cld = dep.Column To dep.Offset(0, Rows(1).Cells.Count - dep.Column).End(xlToLeft).Column
        but.Offset(lgb, clb).Formula = "='" & dep.Worksheet.Name & "'!" & dep.Offset(lgd - 1, cld - 1).Address
        lgb = lgb + 1
    Next cld
    clb = clb + 1
Next lgd
End Sub
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 318
 
RE à tous

Depuis 2009 j'ai évolué (tout du moins, je crois !...)

la nouvelle version printemps-été 2011

'cellule départ tableau( "saison") 
Const dep As String * 2 = "A1" 
'adresse depart restitution (feuille2) 
Const rest As String * 2 = "B2" 

Sub phyto_par_saison() 
Dim lig As Byte, col As Byte, dercol As Byte 

With Sheets(1) 
    lig = .Range(dep).Row 
    col = .Range(dep).Column 
    dercol = .Cells(lig, 255).End(xlToLeft).Column 
End With 
Application.sreenupdating = False 
Sheets(2).Range(rest).Resize(4, dercol) = Application.Transpose(Sheets(1).Range(Cells(lig, col), Cells(4, dercol)).Value) 
End Sub 


les cellules de départ et de restitution sont à adapter

Michel
0