XL 2010 Optimiser le code d'une macro

[KIM]

Bonjour le forum, les ami(e)s,
A partir d'un fichier brut j'ai sélectionné et formaté des colonnes pour créer mon tableau de référence et rajouter 2 autres colonnes avec des formules. Je remercie vivement Pierrejean et vgendron.
Je finalise mon tableau de référence qui me permet de construire mes tableaux de bord avec une dizaine de colonnes rajoutées avec des formules.
1/ J'ai défini mes 10 formules dans des 10 variables et dupliquer 10 fois le code mais avec une formule différente.
Comment définir les noms des formules ou les formules elles même et le titre de la colonne dans un tableau et créer une boucle d'exécution du code ci-dessous :
'Formule9
DerCol = DerCol + 1
With .Cells(NLignEntBaseB, DerCol) 'Avec la cellule ainsi définie
.Value = "M2P" 'On colle l'entête
With .Resize(DerLgn).Offset(1, 0)
.FormulaR1C1 = F_Plus10
.Value = .Value 'Permet d'effacer les Formules
.NumberFormat = "#,##0" 'On formate la plage
End With
End With

2/ Pour réexécuter la macro, comment vider les colonnes rajoutées à partir de la ligne 9 ?

Merci pour votre aide
KIM

 

[pierrejean]

Bonjour KIM

Heureux de te croiser à nouveau

A tester:

Sub A2_FBaseB_AgeBAT_A()



'*****************

'On définit les formules de calcul
    F_SUNsurSUB = "=IF(RC13>2000,RC16/RC15,"""")"
    F_AgeConst = "=IF(AND(RC17=srn,RC18=app),IF(RC10="""",0,IF(RC12="""",R7C2-RC10,0)),0)"
    F_AgeReha = "=IF(AND(RC17=srn,RC18=app),IF(RC10="""",0,IF(RC12="""",0,R7C2-YEAR(RC12))),0)"
    F_Reha5 = "=IF(AND(RC17=srn,RC18=app),IF((RC12=""""),0,IF(R7C2-YEAR(RC12)>5,0,RC13)),0)"
    F_Const5 = "=IF(AND(RC17=srn,RC18=app),IF(ISNUMBER(RC10),IF(R7C2-RC10<=5,RC13-IF(ISNUMBER(RC35),RC[-1],0),0),0),0)"
    F_moins5 = "=IF(AND(RC17=srn,RC18=app),(IF((RC12=""""),0,IF(R7C2-YEAR(RC12)>5,0,RC13)))+(IF(ISNUMBER(RC10),IF(R7C2-RC10<=5,RC13-IF(ISNUMBER(RC35),RC[-2],0),0),0)),0)"
    F_5a10 = "=IF(AND(RC17=srn,RC18=app),IF(ISNUMBER(RC10),IF(AND(R7C2-RC10>5,R7C2-RC10<=10),RC13-IF(ISNUMBER(RC35),RC[-3],0),0),0),0)"
    F_Plus10 = "=IF(AND(RC17=srn,RC18=app),IF(ISNUMBER(RC10),IF(R7C2-RC10>10,RC13-IF(ISNUMBER(RC35),RC[-4],0),0),0),0)"
    F_SurfP = "=0.5*RC38+RC39"
   
    F_SousTot = "=SUBTOTAL(9,R[2]C:R[64984]C)"

'*****************
Application.ScreenUpdating = False



 NOM_Colonnes = Array("N/B", "Age", "AR", "R5", "Const5", "M5", "M510", "pl10", "M2P")
 Formules = Array(F_SUNsurSUB, F_AgeConst, F_AgeReha, F_Reha5, F_Const5, F_moins5, F_5a10, F_Plus10, F_Plus10)
 Formats = Array("0.00%", "#,##0", "#,##0", "#,##0", "#,##0", "#,##0", "#,##0", "#,##0", "#,##0")
  With Sheets("BaseB")
      'Effacement ligne NLignEntBaseB a partir de N/B
     Set c = .Rows(NLignEntBaseB).Find("N/B", LookIn:=xlValues, lookat:=xlWhole)
     If Not c Is Nothing Then
          Range(c.Address & ":" & Cells(NLignEntBaseB, Columns.Count).Address).ClearContents
     End If
      DerCol = .Cells(NLignEntBaseB, .Columns.Count).End(xlToLeft).Column + 1 'On détermine la derniere Colonne Vide de la ligne Entête
      DerLgn = .Cells(NLignEntBaseB, 1).CurrentRegion.Rows.Count - 1       'On détermine le Nombre de ligne de la Plage Cible


      For n = LBound(NOM_Colonnes) To UBound(NOM_Colonnes)
          With .Cells(NLignEntBaseB, DerCol)
            .Value = NOM_Colonnes(n)
             With .Resize(DerLgn).Offset(1, 0)
                 .FormulaR1C1 = Formules(n)
                 .Value = .Value 'Permet d'effacer les Formules
                 .NumberFormat = Formats(n)
              End With
          End With
          DerCol = DerCol + 1
      Next
 End With
End Sub

 

[KIM]

Merci Pierrejean,
Comme d'habitude, une aide appréciable. la macro fonctionne bien, j'ai seulement rajouté après le nom de la colonne un sous-total au dessus de chaque col et déclaré les nouvelles variables :
.Offset(-2, 0).FormulaR1C1 = "=SUBTOTAL(9,R[3]C:R[64985]C)"
Merci encore et bonne journée.
Bien amicalement
KIM

 

[KIM]

Re bonsoir Pierrejean & le forum,
Je reviens vers toi concernant le vidage des colonnes rajoutées.
En exécutant pas à pas la macro j'ai remarqué que le code ci-dessous n'efface que les titres des colonnes supplémentaires sans leur contenu :
Set c = .Rows(NLignEntBaseB).Find("SUN/SUB", LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
.Range(c.Address & ":" & Cells(NLignEntBaseB, Columns.Count).Address).ClearContents
End If

Comment faire pour effacer les titres et le contenu des colonnes ?
Merci d'avance
KIM

 

[pierrejean]

Re
C'est sciemment que seules la ligne est effacée .En effet les contenus sont recouverts par les nouvelles valeurs
Mais si tu veux de la securité:

Range(c.Address & ":" & Cells(Rows.Count, Columns.Count).Address).ClearContents

 

[KIM]

Merci Pierrejean,
En effet je préfère la sécurité. Test OK.
Merci encore et bonne soirée.
KIM