Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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
R
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)"...
Trier par date Trier par votes
R

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

TheProdigy

XLDnaute Impliqué
Super merci beaucoup @Rouge
 
Vote positif 0 Vote négatif

TheProdigy

XLDnaute Impliqué

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
 
Vote positif 0 Vote négatif
R

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
 
Vote positif 0 Vote négatif
Solution

TheProdigy

XLDnaute Impliqué
Super merci beaucoup @Rouge Merci le forum

Bonne jounée!
 
Vote positif 0 Vote négatif

TheProdigy

XLDnaute Impliqué

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
 
Vote positif 0 Vote négatif
R

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

TheProdigy

XLDnaute Impliqué
Merci beaucoup @Rouge
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

R
  • Question
XL 2021 Formule dans un tableau
Réponses
10
Affichages
183
rampon
R
F
  • Résolu(e)
XL 2021 Problèmes de formule ou de mise en forme ????
Réponses
2
Affichages
176
François14850
F
C
  • Résolu(e)
XL 2019 Automatiser des formules
Réponses
4
Affichages
202
cotignac
C
M
  • Question
XL 2013 Automatisation d'un fichier Excel grâce à VBA
Réponses
4
Affichages
426
Moussa040810
M
M
  • Question
Microsoft 365 Pb de formules qui se modifient dans des cellules verrouillées
Réponses
14
Affichages
296
TooFatBoy
  • Question
Microsoft 365 Rafraichissement Listbox
2
Réponses
25
Affichages
706
Calvus
P
  • Question
XL 2016 Validation de données
Réponses
1
Affichages
365
fanch55
X
  • Question
XL 2016 Probleme CSV point virgule en trop
Réponses
4
Affichages
487
xsara63
X
F
  • Question
Microsoft 365 Copier des données en décalant des cellules
Réponses
6
Affichages
200
Frank Bellaisch
F
D
  • Question
XL 2021 2 Listes déroulantes qui ressortent les données que je veux dans un tableau
Réponses
6
Affichages
205
chris
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…