Macro de mise en forme d'une feuille Excel [Résolu/Fermé]

Signaler
-
 Virusxirtam -
Bonjour a tous,

J'ai un grand besoin d'aide !
J'ai passer 2 jours a chercher sur la toile sans reussire a faire ce que je souhaite.

J'ai pour mission très regulierement d'exporter des données de d'un logiciel afin de les retraiter dans excel (2007) - les exports sont tous au meme format (xls)

N° FICHE -- FAMILLE -- TYPE -- DONNEE XX -- DONNEE XX -- CA - MARGE -- % MARGE


La "mise en forme" est toujours la meme, et c'est ce qui me prend le plus de temps ! Je pense qu'il est possible d'automatiser cette partie !

Tout d'abord, il y a un mise en forme esthetique pour faciliter la lecture de la feuille : (simple enregistrement macro)

Code:
Macro ()
Cells.Select
Cells.EntireColumn.AutoFit
ActiveWindow.Zoom = 90
ActiveWindow.Zoom = 80
Cells.EntireColumn.AutoFit
Rows("1:1").Select
Selection.Font.Bold = True
Range("A1").Select
End Sub



Ensuite je souhaite inserer 4 lignes a chaque changment de Type (colone c) ce qui donne:
(au dépard)
TYPE A
TYPE A
TYPE A
TYPE B
TYPE B
TYPE A
TYPE A

(final)
TYPE A
TYPE A
TYPE A

TYPE B
TYPE B

TYPE A
TYPE A

En plus des insertions j'aimerais que le sous total de CA de chaque "type" soit calclué.

Pour plus de facilité, je joint un fichier exemple ainsi que le fichier final !
http://virusxirtam.free.fr/excel/

Enfin pour finir, si nous arrivons a creer cette "marco", comment l'ajouter a un des menu excel ? (puisque les fichier ne sont jamais les memes) ?

Je reste disponible et je surveillerais le forum pour répondre au questions si besoins.

Merci beaucoup pour ce que vous faites !

4 réponses

Messages postés
9802
Date d'inscription
mercredi 11 août 2004
Statut
Contributeur
Dernière intervention
10 novembre 2020
1 085
Bonjour,
Dans un premier temps, essayer la procédure qui suit sur votre classeur [TEST_Export.xls] ;
Sub MiseEnPlace()
reftot = 2
fam = Cells(2, 2).Value: typ = Cells(2, 3).Value
For Each c In Range("B2:B" & Cells((Cells.Rows.Count), 1).End(xlUp).Row + 1)
    If c.Value <> "" Then
    If c.Value = fam And c.Offset(0, 1) = typ Then
'        MsgBox "oui  " & c.Row
    Else
'nouvelle valeur
    fam = Cells(c.Row, 2).Value: typ = Cells(c.Row, 3).Value
'insérer 4 lignes
    Rows(c.Row & ":" & c.Row + 3).Insert Shift:=xlDown
    Range("L" & c.Row - 4).FormulaR1C1 = "=SUM(R[" & (reftot + 3) - c.Row & "]C:R[" & -1 & "]C)"
    reftot = c.Row
    End If
    End If
    fin = c.Row
Next c
    Range("L" & fin).FormulaR1C1 = "=SUM(R[" & (reftot) - fin & "]C:R[" & -1 & "]C)"
End Sub
1
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

CCM 60511 internautes nous ont dit merci ce mois-ci

Messages postés
9802
Date d'inscription
mercredi 11 août 2004
Statut
Contributeur
Dernière intervention
10 novembre 2020
1 085
Bonjour,
J'espère que cela vous conviendra.
Sub MiseEnPlace()
Dim fin As Long, reftot As Long
Dim fam As String, typ As String
reftot = 2
fam = Cells(2, 2).Value: typ = Cells(2, 3).Value
Application.ScreenUpdating = False
For Each C In Range("B2:B" & Cells((Cells.Rows.Count), 1).End(xlUp).Row + 1)
    If C.Value <> "" Then
        If C.Value = fam And C.Offset(0, 1) = typ Then
'        MsgBox "oui  " & c.Row
        Else
'nouvelle valeur
            fam = Cells(C.Row, 2).Value: typ = Cells(C.Row, 3).Value
    'insérer 4 lignes
            Rows(C.Row & ":" & C.Row + 3).Insert Shift:=xlDown
            Range("L" & C.Row - 4).Formula = "=SUM(L" & reftot & ":L" & C.Row - 5 & ")"
            Range("L" & C.Row - 4).AutoFill Destination:=Range("L" & C.Row - 4 & ":N" & C.Row - 4), Type:=xlFillCopy
            With Range("L" & C.Row - 4 & ":N" & C.Row - 4)
                .Font.Bold = True
                .NumberFormat = "#,##0.00"
            End With
            With Range("O" & C.Row - 4)
                .Formula = "=(N" & C.Row - 4 & "/M" & C.Row - 4 & ")"
                .Font.Bold = True
                .Style = "Percent"
                .NumberFormat = "0.00%"
            End With
            reftot = C.Row
        End If
    End If
    fin = C.Row
Next C
    Range("L" & fin).Formula = "=SUM(L" & reftot & ":L" & fin - 1 & ")"
    Range("L" & fin).AutoFill Destination:=Range("L" & fin & ":N" & fin), Type:=xlFillCopy
    With Range("L" & fin & ":N" & fin)
        .Font.Bold = True
        .NumberFormat = "#,##0.00"
    End With
    With Range("O" & fin)
        .Formula = "=(N" & fin & "/M" & fin & ")"
        .Font.Bold = True
        .Style = "Percent"
        .NumberFormat = "0.00%"
    End With
Application.ScreenUpdating = True
End Sub
--
Salutations.
Le Pingou
1
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

CCM 60511 internautes nous ont dit merci ce mois-ci

Bonjour,

C'est ça ! Super, Ca me fait bien les séparations automatiquement.
J'aimerais savoir faire ça tout seul !!

Est-ce que je peu encore abuser te ton savoir ?
Est-ce qu'on peu faire le sous-total a chaque séparation des colonnes L M et N
et juste dans la cellue O a coté des sous-totaux : =(Sous tot N / Sous tot M)% ?
+ metre tous ces résultats en gras (ou, si plus facile toute la ligne des sous totaux en gras)

Merci beaucoup

cdt.
Bonjour,
Ma réponse est très tardive, mais je vous remercie grandement.

C'est super, très fonctionel.
Ca va me faire gagner du temps.

Merci LE PINGOU !
Merci beaucoup

Salutations

Brice