Transformer mon tableau


#1

bonsoir,
j’ai un grand tableau et je voudrait réaranger les données d’une autre manière.

comme dans le fichier joint

tableau.xlsx (9,8 Ko)

je suis novice et un peu paumé
si quelqu’un peut m’aider à le faire en automatique…
merci à tous


#2

Bonjour,

Un petit peu Ardu avec les cellules fusionnées, surtout que les blocs ne sont pas identiques

La Procédure:

Option Explicit
Dim NbLig%, l%, c%, i%, j%, Nbcol%, Dl%, art%           'Déclaration des variables
Sub Transposer()
  Range("H6").CurrentRegion.Clear                       'Efface l'ancien tableau transposé
  
  'ARTICLE
  Range("B2").Select
  Range(Selection, Selection.End(xlDown)).Copy          'Sélection de la colonne B
  Range("D1").Select                                    'copie sur colonne D
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
      :=False, Transpose:=False
  ActiveSheet.Range(Selection, Selection.End(xlDown)).RemoveDuplicates Columns:=1, Header:=xlNo
  Range("D1").Select                                    'Supprime les doublons
  NbLig = Range(Selection, Selection.End(xlDown)).Count 'Mémorise le Nb de ligne dans variable
  Range(Selection, Selection.End(xlDown)).Copy          'Sélectionne les valeurs colonne D
  Range("I6").PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
  Columns("D:D").Clear                                  'Colle les données en I6 en les tranposant en horizontal et efface colonne D
  Nbcol = NbLig                                         'Attribue le Nb ligne à la variable Nbcol (Nb colonne)
  l = 7: c = 8
  
  'BOITE
  Range("A2").Select
  NbLig = Range("A2").MergeArea.Cells.Count             'Récupère le Nb ligne pour le 1er bloc fusionné
  Cells(l, c) = ActiveCell.Value                        'colle les données dans le nouveau tableau
  l = l + 1
    While Selection.Offset(1, 0) <> ""                  'Effectue une boucle sur tous les blocs fusionnés pour les coller à la suite
      Selection.Offset(1, 0).Select
      Cells(l, c) = ActiveCell.Value
      l = l + 1
    Wend
  
  Dl = Range("B" & Rows.Count).End(xlUp).Row            'Dernière ligne colonne B
    Columns("A:A").Select                               'Sélectionne la colonne A et défusionne les blocs
    Selection.UnMerge
    Range("A2").Select
    For i = 2 To Dl
      If Cells(i, 1).Value = "" Then
        Cells(i, 1) = Cells(i - 1, 1)
      End If
    Next i
  
  'QUANTITE
  
  Range("I7").Select                                    'Effectue une triple boucle pour remettre les données dans le nouveau tableau
  For art = 9 To Nbcol + 8
    For j = 7 To NbLig + 6
      For i = 2 To Dl
        If Cells(i, 1).Value = Cells(j, 8).Value And _
          Cells(i, 2).Value = Cells(6, art).Value Then
          Cells(j, art).Value = Cells(i, 3).Value
        End If
      Next i
    Next j
  Next art
  MiseEnForme                                           'Exécute la macro MiseEnForme pour le centrage et le quadrillage
End Sub

Sub MiseEnForme()
    Range(Cells(6, 8), Cells(6, 8).Offset(NbLig, Nbcol)).Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
    End With
    Range("H6").Select
End Sub

Le Classeur

tableau.xlsm (20,8 Ko)


#3

merci pour la réponse, mais franchement j’ai rien compris.
comment faire pour transposer cette macro sur mon tableau qui doit faire un bon millier de ligne.


#4

Re,

D’où le principe de mettre en PJ un exemple concret et qui soit au même endroit :grinning:

La solution, soit mettre ton tABLEAU en PJ, si trop confidentielle me le passer en Message privé


#5

ok, je vois ça lundi et te tiens au courant
merci beaucoup:grinning:


#6

Avoir une assistance c’est mieux je crois
https://msdn.microsoft.com/fr-fr/library/5hah127h(v=vs.110).aspx