Macro de mise en forme d'une feuille Excel
Résolu/Fermé
A voir également:
- Macro de mise en forme d'une feuille Excel
- Mise en forme conditionnelle excel - Guide
- Liste déroulante excel - Guide
- Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Feuille de pointage excel - Télécharger - Tableur
- Formule excel - Guide
4 réponses
Le Pingou
Messages postés
12035
Date d'inscription
mercredi 11 août 2004
Statut
Contributeur
Dernière intervention
1 avril 2024
1 425
13 avril 2010 à 23:54
13 avril 2010 à 23:54
Bonjour,
Dans un premier temps, essayer la procédure qui suit sur votre classeur [TEST_Export.xls] ;
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
Le Pingou
Messages postés
12035
Date d'inscription
mercredi 11 août 2004
Statut
Contributeur
Dernière intervention
1 avril 2024
1 425
14 avril 2010 à 17:49
14 avril 2010 à 17:49
Bonjour,
J'espère que cela vous conviendra.
Salutations.
Le Pingou
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
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.
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.