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

Cells

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
M

momo2394

XLDnaute Occasionnel
Bonjour

Serait-il possible de raccourcir cette formule
Merci

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Cells(17, 10) = Cells(17, 9) - Cells(17, 5)
Cells(18, 10) = Cells(18, 9) - Cells(18, 5)
Cells(19, 10) = Cells(19, 9) - Cells(19, 5)
Cells(20, 10) = Cells(20, 9) - Cells(20, 5)
Cells(21, 10) = Cells(21, 9) - Cells(21, 5)
Cells(22, 10) = Cells(22, 9) - Cells(22, 5)

Cells(26, 10) = Cells(26, 9) - Cells(26, 5)
Cells(27, 10) = Cells(27, 9) - Cells(27, 5)
Cells(28, 10) = Cells(28, 9) - Cells(28, 5)
Cells(29, 10) = Cells(29, 9) - Cells(29, 5)
Cells(30, 10) = Cells(30, 9) - Cells(30, 5)
Cells(31, 10) = Cells(31, 9) - Cells(31, 5)
Cells(32, 10) = Cells(32, 9) - Cells(32, 5)

Cells(34, 10) = Cells(34, 9) - Cells(34, 5)

Cells(36, 10) = Cells(36, 9) - Cells(36, 5)

Cells(38, 10) = Cells(38, 9) - Cells(38, 5)
Cells(39, 10) = Cells(39, 9) - Cells(39, 5)

Cells(54, 10) = Cells(54, 9) - Cells(54, 5)


End Sub
 
Trier par date Trier par votes
Re : Cells

Bonjour


Pourquoi ne pas utiliser de formules ?


Si vraiment tu veux un macro, alors essaie ceci
Code: 
Range(Cells(17, 10), Cells(22, 10)).FormulaR1C1 = "=RC[-1]-RC[-5]"
à la place de:
Code: 
Cells(17, 10) = Cells(17, 9) - Cells(17, 5)
Cells(18, 10) = Cells(18, 9) - Cells(18, 5)
Cells(19, 10) = Cells(19, 9) - Cells(19, 5)
Cells(20, 10) = Cells(20, 9) - Cells(20, 5)
Cells(21, 10) = Cells(21, 9) - Cells(21, 5)
Cells(22, 10) = Cells(22, 9) - Cells(22, 5)

Je te laisse adapter pour le reste
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Cells

Bonjour à tous
Essayez ceci :
Code: 
[COLOR="DarkSlateGray"][B]Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim prm, i, j
   prm = Array(Array(17, 6, 1), Array(26, 7, 1), Array(34, 3, 2), Array(39, 2, 15))
   For i = LBound(prm) To UBound(prm)
      For j = 0 To prm(i)(1) - 1
         Cells(prm(i)(0), 10).Offset(prm(i)(2) * j, 0) = Cells(prm(i)(0), 9).Offset(prm(i)(2) * j, 0) - Cells(prm(i)(0), 5).Offset(prm(i)(2) * j, 0)
      Next j
   Next i
End Sub[/B][/COLOR]
ROGER2327
#4129

Dimanche 8 Absolu 138 (Absinthe, ci devant Saint Alfred, ST)
29 Fructidor An CCXVIII
2010-W37-3T11:49:31Z
 
Vote positif 0 Vote négatif
Re : Cells

Bonsoir

momo2394
Ça fait plaisir d'être transparent 🙄
Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Range("J17:J22,J26:J32,J34,J36,J38:J39").FormulaR1C1 = "=RC[-1]-RC[-5]"
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Cells

Re...
momo2394 à dit:
(...)
pourrai tu me decortiquer la formule avec explication
pour que je puisse comprendre et surtout apprendre
(...)
Cliquez pour agrandir...
Rien de plus simple pour une procédure élémentaire.

On constate que toutes les formules de votre procédure sont identiques au numéro de ligne près.
L'idée qui en découle est d'écrire une unique formule dans laquelle le numéro de ligne serait un paramétre :

Cells(n°_de_ligne, 10) = Cells(n°_de_ligne, 9) - Cells(n°_de_ligne, 5)​

Ce qui pourrait donner :
Code: 
[COLOR="DarkSlateGray"][B]Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim prm, i, j
   prm = Array(17, 18, 19, 20, 21, 22, 26, 27, 28, 29, 30, 31, 32, 34, 36, 38, 39, 54)
   For i = LBound(prm) To UBound(prm)
      Cells(prm(i), 10) = Cells(prm(i), 9) - Cells(prm(i), 5)
   Next i
End Sub[/B][/COLOR]

Toutefois, l'écriture du tableau prm peut-être fastidieuse s'il y a beaucoup de lignes à traiter.
Or, en observant de plus près vos formules, on constate l'existence de blocs de lignes : faire le calcul pour chaque ligne de 17 à 22 (soit 6 lignes), puis de 26 à 32 (soit 7 lignes), puis de 2 en 2 lignes de 34 à 38 (soit 3 lignes), enfin de 15 en 15 lignes de 39 à 54 (soit 2 lignes).
Ce qui donne l'idée d'écrire la formule pour la première ligne de chaque groupe, puis de lui appliquer le décalage voulu autant de fois que nécessaire :

Cells(n°_de_1ère_ligne_du groupe, 10).Offset(n * décalage) = Cells(n°_de_1ère_ligne_du groupe, 9).Offset(n * décalage) - Cells(n°_de_1ère_ligne_du groupe, 5).Offset(n * décalage)​

où n prend successivement les valeurs 0, 1, 2,..., nb_de_lignes_du_groupe -1.

Pour ce faire, on remplace 17, 18, 19, 20, 21, 22 par Array(17, 6, 1), c'est-à-dire Array(n°_de_1ère_ligne_du groupe, nb_de_lignes_du_groupe, décalage). Idem pour les autres groupes.

D'où la procédure :
Code: 
[COLOR="DarkSlateGray"][B]Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim prm, i, j
   prm = Array(Array(17, 6, 1), Array(26, 7, 1), Array(34, 3, 2), Array(39, 2, 15))
   For i = LBound(prm) To UBound(prm)
      For j = 0 To prm(i)(1) - 1
         Cells(prm(i)(0), 10).Offset(prm(i)(2) * j, 0) = Cells(prm(i)(0), 9).Offset(prm(i)(2) * j, 0) - Cells(prm(i)(0), 5).Offset(prm(i)(2) * j, 0)
      Next j
   Next i
End Sub[/B][/COLOR]

Quod erat demonstrandum.

Bon courage !​
ROGER2327
#4131

Dimanche 8 Absolu 138 (Absinthe, ci devant Saint Alfred, ST)
29 Fructidor An CCXVIII
2010-W37-3T19:57:47Z

____________________________
P.s. : Bonjour Staple1600.
 
Dernière édition:
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

T
  • Résolu(e)
XL 2016 macro et feuille protégé
2
Réponses
18
Affichages
1 K
laurent950
K
  • Résolu(e)
XL 2016 Affichage TextBox
Réponses
6
Affichages
818
KRUG WOO
K
A
  • Question Question
XL 2010 Problème ou alternative à SOMPRODUCT en VBA
Réponses
14
Affichages
839
bruno lemaire
B
  • Question Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
2 K
Nicolas JACQUIN
S
  • Question Question
XL 2021 suite de nombre avec changement tous les 5
Réponses
9
Affichages
751
mapomme
M
  • Résolu(e)
XL pour MAC Tirages aléatoires avec critères
2
Réponses
16
Affichages
1 K
crocrocro
C
G
  • Question Question
Microsoft 365 Réduire la taille de la macro ?
Réponses
9
Affichages
1 K
Staple1600
A
  • Question Question
Power Pivot Numéro de semaine ouvrable dans le calendrier dans le modèle de données
Réponses
1
Affichages
279
fanfan38
V
  • Résolu(e)
XL 2016 Facturier : Retour à la ligne sur la facture
2
Réponses
19
Affichages
2 K
Vermithor
V
V
  • Question Question
XL 2016 transformer en boucle une macro créer avec l'enregistreur automatique
Réponses
3
Affichages
241
vazvaz
V
I
  • Résolu(e)
XL 2019 Supprimer une ligne d'une base de données une fois qu'elle est transférée sur une autre feuille
Réponses
8
Affichages
803
Isabellisa
I
T
  • Question Question
Microsoft 365 Problème affichage multipage dans un tabstrip
Réponses
1
Affichages
722
troki74
T
  • Résolu(e)
XL 2016 cellules A, b, C et D sont automatiquement vides
Réponses
3
Affichages
714
job75
M
  • Question Question
Microsoft 365 Problème de non-doublons
Réponses
6
Affichages
604
merinos-BernardEtang
L
  • Question Question
XL 2016 Erreur 28 : Espace de pile insuffisant
Réponses
6
Affichages
713
patricktoulon
  • Question Question
Microsoft 365 datepicker dynamique intra userform ou dans feuille 2 versions(frame dynamique)(toute version d'excel )
6 7 8
Réponses
105
Affichages
5 K
Usine à gaz
  • Résolu(e)
XL 2016 En VBA, Automatiser la réponse en fonction de l'état d'une cellule.
Réponses
7
Affichages
870
piga25
  • Résolu(e)
XL 2021 Un BackColor selon un RAL connu
Réponses
11
Affichages
605
GGI
G
  • Question Question
XL 2019 déterminer valeur selon intervalle de date
Réponses
2
Affichages
589
titooooo
R
  • Question Question
Microsoft 365 Supprimer les lignes vides d'une variable tableau
Réponses
1
Affichages
770
Phil69970
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…