Algo transposition tableau VBA

[richert90]

Bonjour,

J'ai un tableau initial (P.J) que je souhaite transposer dans un 2ième onglet d'Excel.
Je suis bloqué au niveau de l'algorithme qui me permet de transposer le tableau
L'onglet 3 d'Excel est l'aperçu du tableau final souhaité.

Merci de m'aider pour trouver comment faire...
(Vous pouvez voir le peu que j'ai fait en VBA pour transposer le tableau dans le module "transposition")

Merci d'avance

 

[richert90]

Re : Algo transposition tableau VBA

Re,

Paf en effet c'est ce que j'ai fait, j'ai stocké dans des variables le nombre de groupe et le nombre de carte par groupe puis j'insère ces variables directement dans le code.
J'ai modifier également la plage du tableau , pas de la même manière que toi:

DerCol = Worksheets("dataBase").Cells(2, Columns.Count).End(xlToLeft).Column + 1
TAblo = Range(Worksheets("dataBase").Cells(1, 1), Worksheets("dataBase").Cells(NbElement + 1, DerCol))

mais en faisant une boucle pour connaître la dernière ligne et une autre boucle pour connaître la lettre de la colonne:

TAblo = Worksheets(1).Range("A1:" & dernière_colonne & nb_ligne)

Job75 ca marche aussi

En tout cas merci à vous tous, du coup j'ai plein de solutions maintenant 🙂

 

[job75]

Re : Algo transposition tableau VBA

Re,

J'ai testé mon fichier (3) avec 1000 lignes sur la feuille "dataBase".

Avec le calcul manuel => 11 secondes

Sans le calcul manuel => 53 secondes.

Bonne nuit.

 

[ROGER2327]

Re : Algo transposition tableau VBA

Suite...

Comme je l'ai dit plus haut, la première mouture était brute de fonderie, juste pour savoir si j'avais compris le problème. En particulier, tous les résultats étaient rendus sous forme de texte, ce qui n'est pas le plus favorable à l'exploitation.

Voici une version plus sérieuse :​

Sub transposition_tableau()
Dim i&, j&, k&, ub&, uz1&, uz2&, v$, bs, bt, x, y, Champs(), b(), db(), z(), Cel As Range

  uz1 = Feuil1.[A1].End(xlDown).Row - 1
  uz2 = Feuil1.[A1].End(xlToRight).Column
  ReDim db(1 To uz1 + 1, 1 To uz2)
  db = Feuil1.[A1].Resize(uz1 + 1, uz2).Value

  b = Array()

  ub = -1
  For i = 3 To uz2
    If db(1, i) Like "Gr*B* Max" Then
      v = Left$(db(1, i), Len(db(1, i)) - 4)
      For j = 3 To uz2
        If v = db(1, j) Then
          ub = ub + 1
          x = Split(db(1, j), "r")
          y = Split(x(1), "B")
          ReDim Preserve b(ub)
          b(ub) = Array(i, j, CInt(y(0)), CInt(y(1)), v)
          Exit For
        End If
      Next
    End If
  Next

  ReDim z(1 To (ub + 1) * uz1, 1 To 6)

  For j = 2 To uz1 + 1
    bt = CDate(db(j, 1)): bs = CDate(db(j, 2))
    For i = 0 To ub
      k = k + 1
      z(k, 1) = b(i)(2): z(k, 2) = b(i)(3): z(k, 3) = (bt): z(k, 4) = (bs)
      z(k, 5) = db(j, b(i)(1))
      z(k, 6) = db(j, b(i)(0))
    Next
  Next

  With Application: .ScreenUpdating = 0: .EnableEvents = 0: .Calculation = -4135: End With

  Feuil2.[A1].CurrentRegion.Offset(1).ClearContents
  Feuil2.[A1].Resize(k, 6).Offset(1).Value = z

  Set Cel = [A1].Resize(k + 1, 6)
  With Feuil2.Sort
    With .SortFields
      .Clear
      .Add Key:=Cel.Columns(1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
      .Add Key:=Cel.Columns(2), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
    End With
    .SetRange Cel.Cells
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
  End With

  With Application: .Calculation = -4105: .EnableEvents = 1: .ScreenUpdating = 1: End With

End Sub

La rapidité :

• 1s pour 1000 (mille) lignes de données dans l'onglet dataBase (21s avec le code de job75 sur la même machine).
• 10s pour 10 000 (dix mille) lignes de données dans l'onglet dataBase (4min avec le code de job75 sur la même machine).

Le goulot d'étranglement est l'affichage : avec 10 000 lignes de données, le code s'exécute en moins d'une demi-seconde jusqu'à la ligne​

  With Application: .ScreenUpdating = 0: .EnableEvents = 0: .Calculation = -4135: End With

L'affichage est responsable du reste du temps d'exécution... Je ne sais pas comment l'accélérer.
​

Bonne journée.


ℝOGER2327
#7081

Mardi 24 Sable 141 (Sainte Pochetée, gouvernante - fête Suprême Quarte)
4 Nivôse An CCXXII, 1,1549h - soufre
2013-W52-2T02:46:18Z

 

[Paf]

Re : Algo transposition tableau VBA

Re bonjour à tous

J'y suis allé également de mon test de rapidité sur ma machine performante d'il y a 10 ans:

1000 lignes 1 à 2 secondes tout compris, selon les lancements
10000 lignes 2 secondes jusqu'à l'affichage; pas pu tester plus, ayant plus de 300000 lignes à afficher, EXcel 2003 crie: au secours!

a noter : modifier la déclaration des variables de Integer à Long

Bonne journée à tous et à l'année prochaine

 

[job75]

Re : Algo transposition tableau VBA

Bonjour Roger, Paf, le forum,

Je ne m'étonne pas que l'entrée de formules dans la feuille Transpose soit 20 fois plus lente que vos solutions.

En effet pour chaque ligne il y a 2 recherches EQUIV/MATCH et NTime est recalculé 8 fois.

Les tableaux VBA sont la plupart du temps la meilleure solution.

Bonne veille de Noël et A+

 

[richert90]

Re : Algo transposition tableau VBA

Re-bonjour à tous!

Paf j'ai appliqué ta méthode pour un grand tableau (environ 12000 lignes), au début j'ai eu un dépassement de capacité, cela s'est réglé lorsque j'ai passé les décla de variables en Long au lieu d'Integer (nbElement et nbTablo2)
Au niveau du test de rapidité, en effet j'obtiens les même résultats que toi.

Pour le même tableau j'ai testé le code de ROGER2327 qui marche tout aussi bien mais dont inexécution est juste plus longue (17 sec pour un tableau de 12000 lignes)

Je vais voir pour la méthode de job75 mais d'après ce que vous dites, la durée d’exécution est très importante.

En tout cas, encore merci à vous et joyeux noel 🙂

 

[job75]

Re : Algo transposition tableau VBA

Bonjour richert90,

J'ai analysé la durée d'exécution de 11 secondes sur 1000 lignes.

La 1ère colonne avec NBoard (formule matricielle) prend 7 secondes !

Les colonnes 5 et 6 avec MATCH prennent moins de 1 seconde.

En fait il faut figer les valeurs qui peuvent l'être :

Sub Transpose()
Dim h&, b As Byte, P As Range
h = [NTime] 'fige
b = [NBoard] 'fige
Set P = [A2].Resize(h * [NGr] * b, 6)
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
P.Columns(1).FormulaR1C1 = "=N(R[-1]C1)+NOT(MOD(ROW()-2," & h & "*" & b & "))"
P.Columns(2).FormulaR1C1 = "=IF(RC1<>R[-1]C1,1,R[-1]C+NOT(MOD(ROW()-2," & h & ")))"
P.Columns(3).FormulaR1C1 = "=INDEX(dataBase!C1,MOD(ROW()-2," & h & ")+2)"
P.Columns(4).FormulaR1C1 = "=INDEX(dataBase!C2,MOD(ROW()-2," & h & ")+2)"
P.Columns(5).FormulaR1C1 = "=INDEX(OFFSET(Base,,," & h & "+1),MOD(ROW()-2," & h & ")+2,MATCH(""Gr""&RC1&""B""&TEXT(RC2,""00""),Base,0))"
P.Columns(6).FormulaR1C1 = "=INDEX(OFFSET(Base,,," & h & "+1),MOD(ROW()-2," & h & ")+2,MATCH(""Gr""&RC1&""B""&TEXT(RC2,""00"")&"" Max"",Base,0))"
P = P.Value
Range("A" & P.Rows.Count + 2 & ":F" & Rows.Count).ClearContents
Application.Calculation = xlCalculationAutomatic
End Sub

L'exécution est alors 4 fois plus rapide : moins de 3 secondes (Win7 - Excel 2010).

Fichiers (4).

A+

 

[richert90]

Re : Algo transposition tableau VBA

A oui en effet, plus rapide!!

Merci,

J'ai donc 3 possibilités pour ce faire 🙂

 

[richert90]

Re : Algo transposition tableau VBA

Bon tout marche bien pour la transposition. Ensuite je fais des graphiques par groupe (3 graphiques ici avec du coup énormément de données sur le graphique), ce qui provoque une lenteur incroyable pour lancer excel. Le temps entre le moment où je lance le fichier Excel et où je vois concrètement les onglets Excel est de 3-4 minutes. (Les macros d'importations de fichiers, de transposition et pour les graphiques sont réalisées à la suite dès l'ouverture du fichier Excel), d'où cette lenteur d’exécution..

Est-ce possible de gagner du temps ou étant donné que c'est causé par le nombre important de données à traiter et des macros importantes, je ne peux rien y faire?