XL 2010 Automatiosation des formules d'une base de données

TheProdigy

XLDnaute Impliqué
Bonjour,

J'ai des données que j'alimente et des formules qui les traitent. Est-ce possible de les automatiser? J'ai essayé d'insérer un style tableau mais les formules ne prennent pas les dernières lignes

Merci
 

Pièces jointes

  • Automatisation.xlsx
    16.9 KB · Affichages: 23
Solution
pardon, petit oubli, voici le corrigé
Code:
Sub Formule_Auto()
    Dim DerLig As Long
    Application.ScreenUpdating = False
    Range("M6:S10000").Clear
    DerLig = Range("B" & Rows.Count).End(xlUp).Row
    Range("M6:M" & DerLig).FormulaR1C1 = "=RC[-6]"
    Range("N6:N" & DerLig).FormulaR1C1 = "=IF(AND(RC[-6]>0,RC[-7]=0),RC[-6],0)"
    Range("O6:O" & DerLig).FormulaR1C1 = "=IF(IF(OR(AND(RC[-8]>0,RC[-7]>0),AND(RC[-8]<0,RC[-7]>0)),RC[-8],0)<0,IF(OR(AND(RC[-8]>0,RC[-7]>0),AND(RC[-8]<0,RC[-7]>0)),RC[-7],0),IF(OR(AND(RC[-8]>0,RC[-7]>0),AND(RC[-8]<0,RC[-7]>0)),RC[-7],0)-IF(OR(AND(RC[-8]>0,RC[-7]>0),AND(RC[-8]<0,RC[-7]>0)),RC[-8],0))"
    Range("P6:P" & DerLig).FormulaR1C1 = "=IF(OR(AND(RC[-9]>0,RC[-8]=0),AND(RC[-9]>0,RC[-8]<0)),-RC[-9],0)"...

Rouge

XLDnaute Impliqué
Bonjour,

Avec l'aide du VBA:
VB:
Sub Formule_Auto()
    Dim DerLig As Long
    Application.ScreenUpdating = False
    Range("M6:S10000").Clear
    DerLig = Range("B" & Rows.Count).End(xlUp).Row
    Range("M6:M" & DerLig).FormulaR1C1 = "=RC[-6]"
    Range("N6:N" & DerLig).FormulaR1C1 = "=IF(AND(RC[-6]>0,RC[-7]=0),RC[-6],0)"
    Range("O6:O" & DerLig).FormulaR1C1 = "=IF(IF(OR(AND(RC[-8]>0,RC[-7]>0),AND(RC[-8]<0,RC[-7]>0)),RC[-8],0)<0,IF(OR(AND(RC[-8]>0,RC[-7]>0),AND(RC[-8]<0,RC[-7]>0)),RC[-7],0),IF(OR(AND(RC[-8]>0,RC[-7]>0),AND(RC[-8]<0,RC[-7]>0)),RC[-7],0)-IF(OR(AND(RC[-8]>0,RC[-7]>0),AND(RC[-8]<0,RC[-7]>0)),RC[-8],0))"
    Range("P6:P" & DerLig).FormulaR1C1 = "=IF(OR(AND(RC[-9]>0,RC[-8]=0),AND(RC[-9]>0,RC[-8]<0)),-RC[-9],0)"
    Range("Q6:Q" & DerLig).FormulaR1C1 = "=IF(RC[-9]<0,RC[-9],0)"
    Range("R6:R" & DerLig).FormulaR1C1 = "=IF(RC[-11]<0,-RC[-11],0)"
    Range("S6:S" & DerLig).FormulaR1C1 = "=RC[-11]"
    Range("M3:S3").FormulaR1C1 = "=SUM(R[3]C:R[22]C)"
    Range("M3:S" & DerLig).Value = Range("M3:S" & DerLig).Value 'Remplacement des formules par les valeurs
    'Format
    Range("M6:S" & DerLig).Interior.Color = RGB(238, 236, 225)
    Range("M6:S" & DerLig).Borders(xlEdgeLeft).Weight = xlMedium
    Range("M6:S" & DerLig).Borders(xlEdgeTop).Weight = xlMedium
    Range("M6:S" & DerLig).Borders(xlEdgeRight).Weight = xlMedium
End Sub

Cdlt
 

Pièces jointes

  • adilprodigy_Automatiosation des formules d'une base de données.xlsm
    22.2 KB · Affichages: 6

TheProdigy

XLDnaute Impliqué
Bonjour,

Avec l'aide du VBA:
VB:
Sub Formule_Auto()
    Dim DerLig As Long
    Application.ScreenUpdating = False
    Range("M6:S10000").Clear
    DerLig = Range("B" & Rows.Count).End(xlUp).Row
    Range("M6:M" & DerLig).FormulaR1C1 = "=RC[-6]"
    Range("N6:N" & DerLig).FormulaR1C1 = "=IF(AND(RC[-6]>0,RC[-7]=0),RC[-6],0)"
    Range("O6:O" & DerLig).FormulaR1C1 = "=IF(IF(OR(AND(RC[-8]>0,RC[-7]>0),AND(RC[-8]<0,RC[-7]>0)),RC[-8],0)<0,IF(OR(AND(RC[-8]>0,RC[-7]>0),AND(RC[-8]<0,RC[-7]>0)),RC[-7],0),IF(OR(AND(RC[-8]>0,RC[-7]>0),AND(RC[-8]<0,RC[-7]>0)),RC[-7],0)-IF(OR(AND(RC[-8]>0,RC[-7]>0),AND(RC[-8]<0,RC[-7]>0)),RC[-8],0))"
    Range("P6:P" & DerLig).FormulaR1C1 = "=IF(OR(AND(RC[-9]>0,RC[-8]=0),AND(RC[-9]>0,RC[-8]<0)),-RC[-9],0)"
    Range("Q6:Q" & DerLig).FormulaR1C1 = "=IF(RC[-9]<0,RC[-9],0)"
    Range("R6:R" & DerLig).FormulaR1C1 = "=IF(RC[-11]<0,-RC[-11],0)"
    Range("S6:S" & DerLig).FormulaR1C1 = "=RC[-11]"
    Range("M3:S3").FormulaR1C1 = "=SUM(R[3]C:R[22]C)"
    Range("M3:S" & DerLig).Value = Range("M3:S" & DerLig).Value 'Remplacement des formules par les valeurs
    'Format
    Range("M6:S" & DerLig).Interior.Color = RGB(238, 236, 225)
    Range("M6:S" & DerLig).Borders(xlEdgeLeft).Weight = xlMedium
    Range("M6:S" & DerLig).Borders(xlEdgeTop).Weight = xlMedium
    Range("M6:S" & DerLig).Borders(xlEdgeRight).Weight = xlMedium
End Sub

Cdlt
Super merci beaucoup @Rouge
 

TheProdigy

XLDnaute Impliqué
Bonjour,

Avec l'aide du VBA:
VB:
Sub Formule_Auto()
    Dim DerLig As Long
    Application.ScreenUpdating = False
    Range("M6:S10000").Clear
    DerLig = Range("B" & Rows.Count).End(xlUp).Row
    Range("M6:M" & DerLig).FormulaR1C1 = "=RC[-6]"
    Range("N6:N" & DerLig).FormulaR1C1 = "=IF(AND(RC[-6]>0,RC[-7]=0),RC[-6],0)"
    Range("O6:O" & DerLig).FormulaR1C1 = "=IF(IF(OR(AND(RC[-8]>0,RC[-7]>0),AND(RC[-8]<0,RC[-7]>0)),RC[-8],0)<0,IF(OR(AND(RC[-8]>0,RC[-7]>0),AND(RC[-8]<0,RC[-7]>0)),RC[-7],0),IF(OR(AND(RC[-8]>0,RC[-7]>0),AND(RC[-8]<0,RC[-7]>0)),RC[-7],0)-IF(OR(AND(RC[-8]>0,RC[-7]>0),AND(RC[-8]<0,RC[-7]>0)),RC[-8],0))"
    Range("P6:P" & DerLig).FormulaR1C1 = "=IF(OR(AND(RC[-9]>0,RC[-8]=0),AND(RC[-9]>0,RC[-8]<0)),-RC[-9],0)"
    Range("Q6:Q" & DerLig).FormulaR1C1 = "=IF(RC[-9]<0,RC[-9],0)"
    Range("R6:R" & DerLig).FormulaR1C1 = "=IF(RC[-11]<0,-RC[-11],0)"
    Range("S6:S" & DerLig).FormulaR1C1 = "=RC[-11]"
    Range("M3:S3").FormulaR1C1 = "=SUM(R[3]C:R[22]C)"
    Range("M3:S" & DerLig).Value = Range("M3:S" & DerLig).Value 'Remplacement des formules par les valeurs
    'Format
    Range("M6:S" & DerLig).Interior.Color = RGB(238, 236, 225)
    Range("M6:S" & DerLig).Borders(xlEdgeLeft).Weight = xlMedium
    Range("M6:S" & DerLig).Borders(xlEdgeTop).Weight = xlMedium
    Range("M6:S" & DerLig).Borders(xlEdgeRight).Weight = xlMedium
End Sub

Cdlt

Malheureusement les totaux en haut ne prennent pas le total entier jusqu'à la dernière ligne non vide
Code:
M3 jusqu'à S3
M3 jusquà S3

Merci
 

Rouge

XLDnaute Impliqué
pardon, petit oubli, voici le corrigé
Code:
Sub Formule_Auto()
    Dim DerLig As Long
    Application.ScreenUpdating = False
    Range("M6:S10000").Clear
    DerLig = Range("B" & Rows.Count).End(xlUp).Row
    Range("M6:M" & DerLig).FormulaR1C1 = "=RC[-6]"
    Range("N6:N" & DerLig).FormulaR1C1 = "=IF(AND(RC[-6]>0,RC[-7]=0),RC[-6],0)"
    Range("O6:O" & DerLig).FormulaR1C1 = "=IF(IF(OR(AND(RC[-8]>0,RC[-7]>0),AND(RC[-8]<0,RC[-7]>0)),RC[-8],0)<0,IF(OR(AND(RC[-8]>0,RC[-7]>0),AND(RC[-8]<0,RC[-7]>0)),RC[-7],0),IF(OR(AND(RC[-8]>0,RC[-7]>0),AND(RC[-8]<0,RC[-7]>0)),RC[-7],0)-IF(OR(AND(RC[-8]>0,RC[-7]>0),AND(RC[-8]<0,RC[-7]>0)),RC[-8],0))"
    Range("P6:P" & DerLig).FormulaR1C1 = "=IF(OR(AND(RC[-9]>0,RC[-8]=0),AND(RC[-9]>0,RC[-8]<0)),-RC[-9],0)"
    Range("Q6:Q" & DerLig).FormulaR1C1 = "=IF(RC[-9]<0,RC[-9],0)"
    Range("R6:R" & DerLig).FormulaR1C1 = "=IF(RC[-11]<0,-RC[-11],0)"
    Range("S6:S" & DerLig).FormulaR1C1 = "=RC[-11]"
    Range("M3:S3").FormulaR1C1 = "=SUM(R[3]C:R" & DerLig & "C)"
    Range("M3:S" & DerLig).Value = Range("M3:S" & DerLig).Value 'Remplacement des formules par les valeurs
    'Format
    Range("M6:S" & DerLig).Interior.Color = RGB(238, 236, 225)
    Range("M6:S" & DerLig).Borders(xlEdgeLeft).Weight = xlMedium
    Range("M6:S" & DerLig).Borders(xlEdgeTop).Weight = xlMedium
    Range("M6:S" & DerLig).Borders(xlEdgeRight).Weight = xlMedium
End Sub
 

TheProdigy

XLDnaute Impliqué
pardon, petit oubli, voici le corrigé
Code:
Sub Formule_Auto()
    Dim DerLig As Long
    Application.ScreenUpdating = False
    Range("M6:S10000").Clear
    DerLig = Range("B" & Rows.Count).End(xlUp).Row
    Range("M6:M" & DerLig).FormulaR1C1 = "=RC[-6]"
    Range("N6:N" & DerLig).FormulaR1C1 = "=IF(AND(RC[-6]>0,RC[-7]=0),RC[-6],0)"
    Range("O6:O" & DerLig).FormulaR1C1 = "=IF(IF(OR(AND(RC[-8]>0,RC[-7]>0),AND(RC[-8]<0,RC[-7]>0)),RC[-8],0)<0,IF(OR(AND(RC[-8]>0,RC[-7]>0),AND(RC[-8]<0,RC[-7]>0)),RC[-7],0),IF(OR(AND(RC[-8]>0,RC[-7]>0),AND(RC[-8]<0,RC[-7]>0)),RC[-7],0)-IF(OR(AND(RC[-8]>0,RC[-7]>0),AND(RC[-8]<0,RC[-7]>0)),RC[-8],0))"
    Range("P6:P" & DerLig).FormulaR1C1 = "=IF(OR(AND(RC[-9]>0,RC[-8]=0),AND(RC[-9]>0,RC[-8]<0)),-RC[-9],0)"
    Range("Q6:Q" & DerLig).FormulaR1C1 = "=IF(RC[-9]<0,RC[-9],0)"
    Range("R6:R" & DerLig).FormulaR1C1 = "=IF(RC[-11]<0,-RC[-11],0)"
    Range("S6:S" & DerLig).FormulaR1C1 = "=RC[-11]"
    Range("M3:S3").FormulaR1C1 = "=SUM(R[3]C:R" & DerLig & "C)"
    Range("M3:S" & DerLig).Value = Range("M3:S" & DerLig).Value 'Remplacement des formules par les valeurs
    'Format
    Range("M6:S" & DerLig).Interior.Color = RGB(238, 236, 225)
    Range("M6:S" & DerLig).Borders(xlEdgeLeft).Weight = xlMedium
    Range("M6:S" & DerLig).Borders(xlEdgeTop).Weight = xlMedium
    Range("M6:S" & DerLig).Borders(xlEdgeRight).Weight = xlMedium
End Sub
Super merci beaucoup @Rouge Merci le forum

Bonne jounée!
 

TheProdigy

XLDnaute Impliqué
pardon, petit oubli, voici le corrigé
Code:
Sub Formule_Auto()
    Dim DerLig As Long
    Application.ScreenUpdating = False
    Range("M6:S10000").Clear
    DerLig = Range("B" & Rows.Count).End(xlUp).Row
    Range("M6:M" & DerLig).FormulaR1C1 = "=RC[-6]"
    Range("N6:N" & DerLig).FormulaR1C1 = "=IF(AND(RC[-6]>0,RC[-7]=0),RC[-6],0)"
    Range("O6:O" & DerLig).FormulaR1C1 = "=IF(IF(OR(AND(RC[-8]>0,RC[-7]>0),AND(RC[-8]<0,RC[-7]>0)),RC[-8],0)<0,IF(OR(AND(RC[-8]>0,RC[-7]>0),AND(RC[-8]<0,RC[-7]>0)),RC[-7],0),IF(OR(AND(RC[-8]>0,RC[-7]>0),AND(RC[-8]<0,RC[-7]>0)),RC[-7],0)-IF(OR(AND(RC[-8]>0,RC[-7]>0),AND(RC[-8]<0,RC[-7]>0)),RC[-8],0))"
    Range("P6:P" & DerLig).FormulaR1C1 = "=IF(OR(AND(RC[-9]>0,RC[-8]=0),AND(RC[-9]>0,RC[-8]<0)),-RC[-9],0)"
    Range("Q6:Q" & DerLig).FormulaR1C1 = "=IF(RC[-9]<0,RC[-9],0)"
    Range("R6:R" & DerLig).FormulaR1C1 = "=IF(RC[-11]<0,-RC[-11],0)"
    Range("S6:S" & DerLig).FormulaR1C1 = "=RC[-11]"
    Range("M3:S3").FormulaR1C1 = "=SUM(R[3]C:R" & DerLig & "C)"
    Range("M3:S" & DerLig).Value = Range("M3:S" & DerLig).Value 'Remplacement des formules par les valeurs
    'Format
    Range("M6:S" & DerLig).Interior.Color = RGB(238, 236, 225)
    Range("M6:S" & DerLig).Borders(xlEdgeLeft).Weight = xlMedium
    Range("M6:S" & DerLig).Borders(xlEdgeTop).Weight = xlMedium
    Range("M6:S" & DerLig).Borders(xlEdgeRight).Weight = xlMedium
End Sub

Bonjour,

Je reviens vers pour vous demander comment adapter le code de la plage M6 jusqu'en bas la ligne
VB:
Range("M6:S10000").Clear
par un code qui supprime jusqu'à la dernière ligne non vide au lieu de 10000 ème ligne

Merci
Merci
 

Rouge

XLDnaute Impliqué
Bonjour,

Essayez ceci
VB:
Sub Formule_Auto()
    Dim DerLig As Long
    Application.ScreenUpdating = False
    DerLig = Cells.Find("*", , , , xlByRows, xlPrevious).Row
    Range("M6:S" & DerLig).Clear
    DerLig = Range("B" & Rows.Count).End(xlUp).Row
    Range("M6:M" & DerLig).FormulaR1C1 = "=RC[-6]"
    Range("N6:N" & DerLig).FormulaR1C1 = "=IF(AND(RC[-6]>0,RC[-7]=0),RC[-6],0)"
    Range("O6:O" & DerLig).FormulaR1C1 = "=IF(IF(OR(AND(RC[-8]>0,RC[-7]>0),AND(RC[-8]<0,RC[-7]>0)),RC[-8],0)<0,IF(OR(AND(RC[-8]>0,RC[-7]>0),AND(RC[-8]<0,RC[-7]>0)),RC[-7],0),IF(OR(AND(RC[-8]>0,RC[-7]>0),AND(RC[-8]<0,RC[-7]>0)),RC[-7],0)-IF(OR(AND(RC[-8]>0,RC[-7]>0),AND(RC[-8]<0,RC[-7]>0)),RC[-8],0))"
    Range("P6:P" & DerLig).FormulaR1C1 = "=IF(OR(AND(RC[-9]>0,RC[-8]=0),AND(RC[-9]>0,RC[-8]<0)),-RC[-9],0)"
    Range("Q6:Q" & DerLig).FormulaR1C1 = "=IF(RC[-9]<0,RC[-9],0)"
    Range("R6:R" & DerLig).FormulaR1C1 = "=IF(RC[-11]<0,-RC[-11],0)"
    Range("S6:S" & DerLig).FormulaR1C1 = "=RC[-11]"
    Range("M3:S3").FormulaR1C1 = "=SUM(R[3]C:R" & DerLig & "C)"
    Range("M3:S" & DerLig).Value = Range("M3:S" & DerLig).Value 'Remplacement des formules par les valeurs
    'Format
    Range("M6:S" & DerLig).Interior.Color = RGB(238, 236, 225)
    Range("M6:S" & DerLig).Borders(xlEdgeLeft).Weight = xlMedium
    Range("M6:S" & DerLig).Borders(xlEdgeTop).Weight = xlMedium
    Range("M6:S" & DerLig).Borders(xlEdgeRight).Weight = xlMedium
End Sub

Cdlt
 

TheProdigy

XLDnaute Impliqué
Bonjour,

Essayez ceci
VB:
Sub Formule_Auto()
    Dim DerLig As Long
    Application.ScreenUpdating = False
    DerLig = Cells.Find("*", , , , xlByRows, xlPrevious).Row
    Range("M6:S" & DerLig).Clear
    DerLig = Range("B" & Rows.Count).End(xlUp).Row
    Range("M6:M" & DerLig).FormulaR1C1 = "=RC[-6]"
    Range("N6:N" & DerLig).FormulaR1C1 = "=IF(AND(RC[-6]>0,RC[-7]=0),RC[-6],0)"
    Range("O6:O" & DerLig).FormulaR1C1 = "=IF(IF(OR(AND(RC[-8]>0,RC[-7]>0),AND(RC[-8]<0,RC[-7]>0)),RC[-8],0)<0,IF(OR(AND(RC[-8]>0,RC[-7]>0),AND(RC[-8]<0,RC[-7]>0)),RC[-7],0),IF(OR(AND(RC[-8]>0,RC[-7]>0),AND(RC[-8]<0,RC[-7]>0)),RC[-7],0)-IF(OR(AND(RC[-8]>0,RC[-7]>0),AND(RC[-8]<0,RC[-7]>0)),RC[-8],0))"
    Range("P6:P" & DerLig).FormulaR1C1 = "=IF(OR(AND(RC[-9]>0,RC[-8]=0),AND(RC[-9]>0,RC[-8]<0)),-RC[-9],0)"
    Range("Q6:Q" & DerLig).FormulaR1C1 = "=IF(RC[-9]<0,RC[-9],0)"
    Range("R6:R" & DerLig).FormulaR1C1 = "=IF(RC[-11]<0,-RC[-11],0)"
    Range("S6:S" & DerLig).FormulaR1C1 = "=RC[-11]"
    Range("M3:S3").FormulaR1C1 = "=SUM(R[3]C:R" & DerLig & "C)"
    Range("M3:S" & DerLig).Value = Range("M3:S" & DerLig).Value 'Remplacement des formules par les valeurs
    'Format
    Range("M6:S" & DerLig).Interior.Color = RGB(238, 236, 225)
    Range("M6:S" & DerLig).Borders(xlEdgeLeft).Weight = xlMedium
    Range("M6:S" & DerLig).Borders(xlEdgeTop).Weight = xlMedium
    Range("M6:S" & DerLig).Borders(xlEdgeRight).Weight = xlMedium
End Sub

Cdlt
Merci beaucoup @Rouge
 

Discussions similaires

Réponses
25
Affichages
603