VBA - Mise en forme d'un tableau

W

wizard0147

XLDnaute Occasionnel
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 :)
 

Pièces jointes

  • Test.xlsx
    10.5 KB · Affichages: 110
  • Test.xlsx
    10.5 KB · Affichages: 124
  • Test.xlsx
    10.5 KB · Affichages: 122
Trier par date Trier par votes
Grand Chaman Excel

Grand Chaman Excel

XLDnaute Impliqué
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+
 
Vote positif 0 Vote négatif
JCGL

JCGL

XLDnaute Barbatruc
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
 
Dernière édition:
Vote positif 0 Vote négatif
Y

Yaloo

XLDnaute Barbatruc
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
 
Vote positif 0 Vote négatif
JCGL

JCGL

XLDnaute Barbatruc
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
 
Vote positif 0 Vote négatif
DoubleZero

DoubleZero

XLDnaute Barbatruc
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 :eek: !

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

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 :D et Yaloo :D.

A bientôt :)
 
Vote positif 0 Vote négatif
Y

Yaloo

XLDnaute Barbatruc
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
 
Vote positif 0 Vote négatif
W

wizard0147

XLDnaute Occasionnel
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 :confused:

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

Merci encore :)
 
Dernière édition:
Vote positif 0 Vote négatif
W

wizard0147

XLDnaute Occasionnel
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 !
 
Vote positif 0 Vote négatif
Y

Yaloo

XLDnaute Barbatruc
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.
Cliquez pour agrandir...

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
 
Vote positif 0 Vote négatif
Grand Chaman Excel

Grand Chaman Excel

XLDnaute Impliqué
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+
 
Vote positif 0 Vote négatif

Discussions similaires

L
  • Résolu(e)
XL 2019 Correction de la formule
Réponses
7
Affichages
478
labombola46
L
S
  • Résolu(e)
Microsoft 365 Vba, Mise en forme d'un calendrier
Réponses
8
Affichages
180
SOP
S
A
  • Résolu(e)
Microsoft 365 Correction du code vba
Réponses
5
Affichages
259
AD95
A
Z
  • Question
XL 2016 RECHERCHEV et double liste de choix
Réponses
2
Affichages
331
zendb
Z
F
  • Question
XL 2016 Faire une somme en fonction de 2 critères + 1 critère si contient un texte
Réponses
2
Affichages
315
flo189
F
Z
  • Question
Microsoft 365 Mise en forme de tableau et répétition de formule
Réponses
2
Affichages
247
DJunqueira
D
R
  • Résolu(e)
XL 2016 Somme par année en fonction d'une date de début et de fin
Réponses
4
Affichages
395
remyexcel
R
I
  • Résolu(e)
Microsoft 365 Trier les colonnes d'un tableau de A à Z en VBA
Réponses
11
Affichages
441
iliess
I
S
  • Résolu(e)
Microsoft 365 Appliquer par vba une mise en forme conditionnelle d'après une liste de cellules mises en forme
Réponses
9
Affichages
350
Dranreb
Dranreb
M
  • Résolu(e)
XL 2016 Résumé de tableau complexe
Réponses
8
Affichages
293
M@xu3L
M

Membres actuellement en ligne

8 membres et 104 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 677
Messages
2 090 811
Membres
104 671
dernier inscrit
Guilbry