VBA - Mise en forme d'un tableau

wizard0147 · 2 Juillet 2013

Bonsoir à tous,

Il m'arrive fréquemment de devoir récupérer des tableaux et de devoir les retravailler. Cela me prend pas mal de temps et j'essaie de mettre en place une macro qui me simplifierai grandement la vie.

La demande est assez simple car il s'agit de mettre en forme. Mon problème est que chaque tableau comporte un nombre de lignes différents.

J'ai mis en pièce jointe un exemple. Le type de tableau est toujours le même. Ils commencent tous au même endroit mais ils comportent des nombres de lignes différents.

Je cherche à faire les opérations suivantes :

1 - Dans le tableau, remplacez les cellules vides par des 0

2 - Ajouter dans la colonne Z, la somme des € sur les différents mois

3 - Ajouter dans la colonne AA, la somme des Kg sur les différents mois

4 - Ajouter dans la colonne AB, la formule Z/AA

5 - A la fin du tableau, j'aimerai rajouter une ligne TOTAL qui calcule le sous.total de chaque colonne (jusque AA)

6 - Suppression des lignes ou Z et AA sont toutes les deux à 0

7 - Supprimer les lignes qui contiennent EUR15 et EUR27 dans la colonne A. Attention ces lignes ne se trouvent pas toujours au même endroit

Merci d'avance pour votre aide 🙂

Grand Chaman Excel · 2 Juillet 2013

Re : VBA - Mise en forme d'un tableau

Bonjour wizard0147,

Code à essayer :

VB:

Sub MiseEnformeTableau()
   Dim rg As Range, lrow As Long, i As Long
   
   Application.ScreenUpdating = False
   
   lrow = Range("A65000").End(xlUp).Row
   Set rg = Range("A12:Y" & lrow)
   On Error Resume Next
   rg.SpecialCells(xlCellTypeBlanks) = 0
   On Error GoTo 0
   Range("Z10") = "Total"
   Range("Z11") = "€"
   Range("AA11") = "Kg"
   Range("Z12").Resize(rg.Rows.Count, 2).FormulaR1C1 = "=RC[-24]+RC[-22]+RC[-20]+RC[-18]+RC[-16]+RC[-14]+RC[-12]+RC[-10]+RC[-8]+RC[-6]+RC[-4]+RC[-2]"
   Range("AB12").Resize(rg.Rows.Count, 1).FormulaR1C1 = "=RC[-2]/RC[-1]"
   Range("B" & lrow + 1 & ":AA" & lrow + 1).FormulaR1C1 = "=SUM(R12C:R[-1]C)"
   For i = lrow To 12 Step -1
      If Cells(i, 1) = "EUR15" Or Cells(i, 1) = "EUR27" Or IsError(Cells(i, "AB")) Then
         Rows(i).EntireRow.Delete
      End If
   Next i
   Application.ScreenUpdating = True
End Sub

A+

JCGL · 2 Juillet 2013

Re : VBA - Mise en forme d'un tableau

Bonjour à tous,

Peux-tu essayer avec ceci :

VB:

Option Explicit


Sub MeF()
    Dim DerL&, Plage As Range, Cel As Range, X&
    DerL = Feuil1.Range("A5000").End(xlUp).Row
    Set Plage = Range("B12:AB" & DerL)
    For Each Cel In Plage
        If Cel = "" Then Cel = 0
    Next Cel


    Range("X11:Y11").Copy Range("Z11")
    Range("Z12:AA" & DerL).Formula = _
    "=SUM(RC[-24],RC[-22],RC[-20],RC[-18],RC[-16],RC[-14],RC[-12],RC[-10],RC[-8],RC[-6],RC[-4],RC[-2])"
    Range("AB12:AB" & DerL).Formula = "=IF(ISERROR(RC[-2]/RC[-1]),"""",RC[-2]/RC[-1])"


    Range("B9:AB9").Formula = "=SUM(R[3]C:R[16]C)"


    For Each Cel In Plage
        Cel = Cel
    Next Cel


    For X = 12 To DerL
        If Feuil1.Cells(X, 28) = "" Or Feuil1.Cells(X, 1) = "EUR15" Or Feuil1.Cells(X, 1) = "EUR17" Then Rows(X).EntireRow.Delete
    Next X
End Sub

A+ à tous

Edition : Bonjour GCE

Yaloo · 2 Juillet 2013

Re : VBA - Mise en forme d'un tableau

Bonsoir à tout le monde, et quel beau monde 😉

Une version sans formules qui alourdissent les fichiers s'il y a vraiment beaucoup de lignes.

VB:

Option Explicit
Sub MiseEnForme()
Dim i&, c&, DerL&, Cel As Range
Dim SommeE&, SommeKg&
[Z10:AB10] = "Total": [Z11] = "€": [AA11] = "Kg": [AB11] = "€/Kg"
DerL = [A65536].End(xlUp).Row
For Each Cel In Range("A12:Y" & DerL)
  If Cel = "" Then Cel = 0
Next
For i = DerL To 12 Step -1
  For c = 2 To 24 Step 2
    SommeE = SommeE + Cells(i, c)
    SommeKg = SommeKg + Cells(i, c + 1)
  Next
  Cells(i, 26) = SommeE
  Cells(i, 27) = SommeKg
  If Cells(i, 26) = 0 And Cells(i, 27) = 0 Then
    Rows(i).Delete
  Else
    Cells(i, 28) = SommeE / SommeKg
  End If
  SommeE = 0: SommeKg = 0
Next
DerL = [A65536].End(xlUp)(2).Row
For c = 2 To 25
  Cells(DerL, c) = Application.WorksheetFunction.Sum(Cells(12, c), Cells(DerL - 1, c))
Next
[A10].CurrentRegion.Borders.LineStyle = xlContinuous
[A10].CurrentRegion.HorizontalAlignment = xlCenter
For i = DerL To 1 Step -1
  If Cells(i, 1) Like "*EUR15*" Or Cells(i, 1) Like "*EUR27*" Then Rows(i).Delete
Next
End Sub

A+

Martial

JCGL · 2 Juillet 2013

Re : VBA - Mise en forme d'un tableau

Bonjour à tous,
Salut Martial,

Es-tu prêt pour une comparaison ?

Si tu as le temps et l'envie, peux-tu sur un nombre de lignes important, rajouter un Timer, sur les trois codes, et nous renvoyer le résultat ?

A++
A+ à tous

Yaloo · 2 Juillet 2013

Re : VBA - Mise en forme d'un tableau

Salut JC,

Je n'ai pas dit le temps de calcul, je me suis peut-être mal exprimé, je parlais de poids de fichier.

On peut essayer, maintenant tu me mets le doute 😱

Allez go....

A+

DoubleZero · 2 Juillet 2013

Re : VBA - Mise en forme d'un tableau

Bonjour, wizard0147, Grand Chaman Excel, JCGL, Yaloo, le Forum,

Comme je le dis souvent, le ridicule ne tue pas 😱 !

Par conséquent, une autre suggestion... bien moins élégante 🙄 :

Code:

Option Explicit
Sub Opérations_présentation()
    Dim Plage As Range
    Dim c As Range
    Application.ScreenUpdating = False
    Set Plage = Range("a10").CurrentRegion
    For Each c In Plage
        c.Replace "EUR15", ""
        c.Replace "EUR27", ""
        c.Replace "", 0
    Next
    Range("z10") = "Total €"
    Range("aa10") = "Total Kg"
    Range("ab10") = "€ / Kg"
    Range("z12:z" & Range("y65536").End(xlUp).Row).FormulaR1C1 = "=SUM(RC[-24],RC[-22],RC[-20],RC[-18],RC[-16],RC[-14],RC[-12],RC[-10],RC[-8],RC[-6],RC[-4],RC[-2])"
    Range("aa12:aa" & Range("y65536").End(xlUp).Row).FormulaR1C1 = "=SUM(RC[-24],RC[-22],RC[-20],RC[-18],RC[-16],RC[-14],RC[-12],RC[-10],RC[-8],RC[-6],RC[-4],RC[-2])"
    Range("ab12:ab" & Range("y65536").End(xlUp).Row).FormulaR1C1 = "=RC[-2]/RC[-1]"
    With Columns("ab:ab")
        .NumberFormat = "#,##0.00"
        .SpecialCells(xlCellTypeFormulas, 16).EntireRow.Delete
    End With
    Range("a12").End(xlDown).Offset(1, 0).Name = "total"
    With Range("total")
        .Value = "TOTAL"
        .Offset(, 1).FormulaR1C1 = "=SUM(R[-10]C:R[-1]C)"
        .Offset(, 1).AutoFill Destination:=Range("total").Offset(, 1).Resize(, 26), Type:=xlFillDefault
        .Offset(, 27).Value = "Sans objet"
    End With
    Range("a10").CurrentRegion.Borders.Value = 1
    With Range("Z10:AB11,total")
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
        .Interior.ColorIndex = 36
    End With
    With Range("Z10:Z11,AA10:AA11,AB10:AB11")
        .Merge
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
    ActiveWorkbook.Names("total").Delete
    Application.ScreenUpdating = True
End Sub

Bises à JCGL 😀 et Yaloo 😀.

A bientôt 🙂

Yaloo · 2 Juillet 2013

Re : VBA - Mise en forme d'un tableau

Bises 00 ça faisait bien longtemps que nous ne nous étions pas rencontré sur un fil 😉

Jean-Claude, j'ai fais quelques tests sur 20000 lignes.

Fichier de départ : 2231 ko

Avec ta macro, le fichier pèse 1911 ko, le temps d'exécution est de presque 6 minutes, 359 secondes exactement.

Avec la mienne, le fichier pèse 1893 ko et le temps d'exécution est de 19 secondes et quelques.

Donc, je me suis trompé sur le poids du fichier, il n'y a pas beaucoup de différence 72 ko autrement dit rien du tout.

A+

Martial

wizard0147 · 3 Juillet 2013

Re : VBA - Mise en forme d'un tableau

Je comprends maintenant pourquoi je ne voyais pas par ou commencer. Merci beaucoup pour votre aide rapide, je vais essayer tout ça, essayer de comprendre et je reviens vers vous 🙂

wizard0147 · 3 Juillet 2013

Re : VBA - Mise en forme d'un tableau

Rebonjour,

J'ai modifié finalement le code de DoubleZero 🙂
Il me semble que c'est le code le plus rapide. De plus, il permet de garder les formules dans les cellules. Et il me semble également plus simple.
Après (petite) adaptation j'ai donc ça :

Code:

Sub Mise_en_forme

    Dim Plage As Range
    Dim c As Range
    Application.ScreenUpdating = False
    Set Plage = Range("a10").CurrentRegion
    For Each c In Plage
    c.Replace "", 0
    Next
   
    Range("z12:z" & Range("y65536").End(xlUp).Row).FormulaR1C1 = "=SUM(RC[-24],RC[-22],RC[-20],RC[-18],RC[-16],RC[-14],RC[-12],RC[-10],RC[-8],RC[-6],RC[-4],RC[-2])"
    
    Range("aa12:aa" & Range("y65536").End(xlUp).Row).FormulaR1C1 = "=SUM(RC[-24],RC[-22],RC[-20],RC[-18],RC[-16],RC[-14],RC[-12],RC[-10],RC[-8],RC[-6],RC[-4],RC[-2])"
    
    Range("ab12:ab" & Range("y65536").End(xlUp).Row).FormulaR1C1 = "=RC[-2]/RC[-1]"
    With Columns("ab:ab")
        .NumberFormat = "#,##0.000"
        .SpecialCells(xlCellTypeFormulas, 16).EntireRow.Delete
    End With
    
    Range("a12").End(xlDown).Offset(1, 0).Name = "total"
    With Range("total")
        .Value = "TOTAL"
        .Offset(, 1).FormulaR1C1 = "=SUBTOTAL(9,R[-10]C:R[-1]C)"
        .Offset(, 1).AutoFill Destination:=Range("total").Offset(, 1).Resize(, 26), Type:=xlFillDefault
        .Offset(, 27).FormulaR1C1 = "=RC[-2]/RC[-1]"
    End With
   
    Range("a10").CurrentRegion.Borders.Value = 1
    
    With Range("B12:AA200")
        .NumberFormat = "#,##0"
    End With
 
    ActiveWorkbook.Names("total").Delete
    Application.ScreenUpdating = True
  
End Sub

J'ai fait plusieurs essais et ça marche super 🙂

Par contre j'ai oublié un petit truc. Lorsque je récupère le tableau, les volumes sont en tonne et non en Kg. Ainsi, je dois multiplier les valeurs des colonnes C/E/G/I/K/M/O/Q/S/U/W/Y par 100.
Est-ce qu'il serait possible de mettre une petite ligne de code qui fasse ça 😕

Enfin dernière petite chose, je souhaiterai mettre la dernière ligne (TOTAL) en police blanche sur fond noir.

Merci encore 🙂

DoubleZero · 3 Juillet 2013

Re : VBA - Mise en forme d'un tableau

Bonjour, le Fil, le Forum,

Dans le fichier joint, quelques modifications à tester.

A bientôt 🙂

wizard0147 · 3 Juillet 2013

Re : VBA - Mise en forme d'un tableau

Merci beaucoup pour ta rapidité DoubleZero (et pour la belle présentation !)
Bon j'ai refait quelques modifications et ça a l'air de marcher au poil. Je vais tester ça sur quelques tableaux.

Merci beaucoup pour votre aide à tous !

Yaloo · 3 Juillet 2013

Re : VBA - Mise en forme d'un tableau

Bonsoir tout le monde,

wizard0147 à dit:
J'ai modifié finalement le code de DoubleZero 🙂
Il me semble que c'est le code le plus rapide.

Eh bien non, pour un fichier avec 20000 lignes, voici les résultats avec les codes de JC, grand Chaman, le mien et celui d'origine de DoubleZéro, avec dans l'ordre d'apparition :

Grand Chaman : 2169 ko, temps : 360 secondes
JC : 1911 ko, temps : 351 secondes
Yaloo : 1893 ko, temps : 20 secondes
00 : 2217 ko, temps : 377 secondes

A+

Martial

Grand Chaman Excel · 3 Juillet 2013

Re : VBA - Mise en forme d'un tableau

Bonjour à tous,

Pour le fun...
En adaptant le code de Yaloo pour utiliser des tableaux pour les calculs, j'arrive à 12.73 secondes sur mon PC pour 20000 lignes de données.
Qui dit mieux?? 😉

1865 Ko, Temps : 12.73 secondes

VB:

Sub MiseEnForme()
   Dim i&, c&, DerL&, Cel As Range, ar, j&, n&
   Dim SommeE&, SommeKg&
   
   Application.ScreenUpdating = False
   
   [Z10:AB10] = "Total": [Z11] = "€": [AA11] = "Kg": [AB11] = "€/Kg"
   DerL = [A65536].End(xlUp).Row

   For Each Cel In Range("A12:Y" & DerL)
         If Cel = "" Then Cel = 0
   Next Cel
   ar = Range("A12:Y" & DerL).Value


   ReDim Preserve ar(1 To UBound(ar, 1), 1 To UBound(ar, 2) + 3)
   n = 1
   For i = UBound(ar, 1) To 1 Step -1
      For j = 2 To 24 Step 2
         SommeE = SommeE + ar(i, j)
         SommeKg = SommeKg + ar(i, j + 1)
      Next
      ar(i, 26) = SommeE
      ar(i, 27) = SommeKg
      If ar(i, 26) <> 0 And ar(i, 27) <> 0 And (Not ar(i, 1) Like "*EUR15*" Or Not ar(i, 1) Like "*EUR27") Then
         For j = 1 To 27
            ar(n, j) = ar(i, j)
         Next j
         ar(n, 28) = SommeE / SommeKg
         n = n + 1
      End If
      SommeE = 0: SommeKg = 0
   Next i
   Range("A12:Y" & DerL).Clear
   Range("A12").Resize(n, UBound(ar, 2)) = ar
   DerL = [A65536].End(xlUp).Row + 1
   Range("A" & DerL).Offset(0, 1).Resize(1, 24).FormulaR1C1 = "=SUM(R12C:R[-1]C)"
   [A10].CurrentRegion.Borders.LineStyle = xlContinuous
   [A10].CurrentRegion.HorizontalAlignment = xlCenter
   
   Application.ScreenUpdating = True

End Sub

A+

VBA - Mise en forme d'un tableau

wizard0147

XLDnaute Occasionnel

Pièces jointes

Grand Chaman Excel

XLDnaute Impliqué

JCGL

XLDnaute Barbatruc

Yaloo

XLDnaute Barbatruc

JCGL

XLDnaute Barbatruc

Yaloo

XLDnaute Barbatruc

DoubleZero

XLDnaute Barbatruc

Yaloo

XLDnaute Barbatruc

wizard0147

XLDnaute Occasionnel

wizard0147

XLDnaute Occasionnel

DoubleZero

XLDnaute Barbatruc

Pièces jointes

wizard0147

XLDnaute Occasionnel

Yaloo

XLDnaute Barbatruc

Grand Chaman Excel

XLDnaute Impliqué

Discussions similaires

VBA - Mise en forme d'un tableau

XLDnaute Occasionnel

Pièces jointes

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Occasionnel

XLDnaute Barbatruc

Pièces jointes

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Impliqué

Discussions similaires

Privacy & Transparency

Privacy & Transparency