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

Créer une discussion

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire

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

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
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

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

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
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
Super merci beaucoup @Rouge Merci le forum

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

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
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
Merci beaucoup @Rouge
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

D
  • Résolu(e)
Microsoft 365 Formules adjacentes après un import ne suivent pas
2 3 4
Réponses
45
Affichages
5 K
Dand87
D
  • Résolu(e)
Microsoft 365 Fonction Index/Equiv dans Recherche V
Réponses
5
Affichages
279
VBA_dev_Anne_Marie
M
  • Question Question
XL 2016 Filtre une Base de données a partir d'un ComboBox
Réponses
2
Affichages
134
jcf6464
B
  • Question Question
XL 2021 Base de données
Réponses
5
Affichages
429
Cousinhub
B
  • Question Question
Microsoft 365 Faire la somme de plusieurs tableaux
2
Réponses
17
Affichages
1 K
AtTheOne
C
  • Question Question
XL pour MAC Classeur Excel pour tenue de livre
Réponses
1
Affichages
162
wDog66
S
  • Question Question
Microsoft 365 Trouver les correspondances de mots entre deux listes
2
Réponses
26
Affichages
734
Sylvaing
S
J
  • Résolu(e)
Microsoft 365 Anomalie tri colonnes d’un tableau
Réponses
14
Affichages
547
JPC33
J
C
  • Question Question
XL 2016 récupérer la mise en forme d'une cellule vers une autre cellule
Réponses
1
Affichages
422
TooFatBoy
J
  • Question Question
XL 2021 Excel CSV vers XSL et ne pas écraser les données
Réponses
9
Affichages
346
sylvanu
T
  • Résolu(e)
XL 2010 VBA - Insérer image proportionnelle à la taille de la cellule
Réponses
8
Affichages
246
job75
A
  • Question Question
XL 2021 Comment préserver la première valeur d'une cellule uniquement si
2 3
Réponses
34
Affichages
1 K
Alamyr
A
M
  • Question Question
XL pour MAC Liaison Excel vers Word
Réponses
1
Affichages
249
wDog66
T
  • Question Question
XL 2019 B
Réponses
10
Affichages
412
Piment
P
R
  • Question Question
Microsoft 365 Feuille de résultats
Réponses
10
Affichages
222
Cousinhub
D
  • Résolu(e)
XL 2016 Filtrage ListBox d'un userform
Réponses
6
Affichages
120
dgil37
D
B
  • Question Question
Microsoft 365 Protection de zone de cellule selon utilisateur sur un fichier Excel
Réponses
2
Affichages
180
berta8683
B
Y
  • Question Question
XL 2019 Masquer automatiquement des lignes selon la valeur d'une cellule ?
Réponses
2
Affichages
318
Yogean
Y
P
  • Question Question
XL pour MAC MAC OS - question sur macro VBA pour gestion fichier budget
Réponses
0
Affichages
145
pamino
P
C
  • Question Question
Microsoft 365 macro copie de feuilles (avec formules à adapter)
Réponses
9
Affichages
357
caseras
C
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…