Macro pour additionner des colonnes...

[Christian0258]

Bonjour à tout le forum,

Je souhaiterais votre aide afin d'écrire une macro pour additionner le contenu de(s) colonne(s) préalablement choisie(s) et de coller ensuite le résultat de l'addition dans une des colonnes également choisie...

voir fichier

Je vous remercie, par avance, pour votre aide et pour le temps que vous voudrez bien vouloir m'accorder.

Bien à vous,
Christian

 

[youky(BJ)]

Re : Macro pour additionner des colonnes...

Bonjour Christian,
Userform et listbox
Voir si c'est ton attente
Bruno

 

[job75]

Re : Macro pour additionner des colonnes...

Bonjour Christian, Bruno,

Avec 2 InputBoxes :

Sub Additionner()
Dim r1 As Range, r2 As Range, i&
On Error Resume Next
Set r1 = Application.InputBox("Sélectionnez les colonnes (F à L) à additionner :", "Addition", , , , , , 8)
Set r1 = Intersect(r1.EntireColumn, [F2:L65536], ActiveSheet.UsedRange)
If r1 Is Nothing Then Exit Sub
Set r2 = Application.InputBox("Sélectionnez la colonne (R à V) du résultat :", "Addition", , , , , , 8)
Set r2 = Intersect(r2(1).EntireColumn, [R2:V65536], ActiveSheet.UsedRange)
For i = 1 To r2.Count
  r2(i) = Application.Sum(Intersect(r1, r2(i).EntireRow))
Next
End Sub

Bien entendu la sélection de colonnes disjointes se fait avec la touche Ctrl enfoncée.

Noter qu'on peut ne sélectionner qu'une cellule par colonne.

Fichier joint.

A+

 

[Christian0258]

Re : Macro pour additionner des colonnes...

Re bonsoir à tout le forum, youky, job75,

Que dire, à part un grand merci pour vos solutions.
Je suis, à chaque fois, étonné de ce que vous pouvez réaliser...c'est parfait.
Encore merci les artistes.

Bien amicalement,
Christian

 

[job75]

Re : Macro pour additionner des colonnes...

Bonjour Christian, le forum,

Pour être certain qu'on ne s'est pas trompé, il est peut-être mieux d'entrer des formules :

Sub Additionner()
Dim r1 As Range, r2 As Range
On Error Resume Next
Set r1 = Application.InputBox("Sélectionnez les colonnes (F à L) à additionner :", "Addition", , , , , , 8)
Set r1 = Intersect(r1.EntireColumn, [F2:L65536], ActiveSheet.UsedRange)
If r1 Is Nothing Then Exit Sub
Set r2 = Application.InputBox("Sélectionnez la colonne (R à V) du résultat :", "Addition", , , , , , 8)
Set r2 = Intersect(r2(1).EntireColumn, [R2:V65536], ActiveSheet.UsedRange)
r2 = "=SUM(" & Intersect(r1, r2(1).EntireRow).Address(0, 0, xlR1C1, , r2(1)) & ")"
r2(1).Select 'facultatif
End Sub

Fichier (2).

A+

 

[job75]

Re : Macro pour additionner des colonnes...

Re,

Avec des CheckBoxes et le double-clic c'est bien aussi :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, [R1:V1]) Is Nothing Then Exit Sub
Dim i As Byte, r1 As Range, r2 As Range
Cancel = True
For i = 6 To 12 'n° des colonnes
  If Me.OLEObjects("CheckBox" & i - 5).Object Then _
    Set r1 = Union(Columns(i), IIf(r1 Is Nothing, Columns(i), r1))
Next
If r1 Is Nothing Then Exit Sub
Set r1 = Intersect(r1, [2:65536], Me.UsedRange)
Set r2 = Intersect(Target.EntireColumn, [2:65536], Me.UsedRange)
r2 = "=SUM(" & Intersect(r1, r2(1).EntireRow).Address(0, 0, xlR1C1, , r2(1)) & ")"
r2 = r2.Value 'facultatif, supprime les formules
End Sub

Fichier joint.

A+

 

[Christian0258]

Re : Macro pour additionner des colonnes...

Re, le forum, Bonjour à tous, Youky, job75,

Je reviens sur les solutions apportées par , Youky et job75, qui je remercie.

Je voudrais savoir si dans la macro de job75, du post3, il serai possible d'intégrer dans l'addition cet arrondi...Arrondi.Sup(...;0) ?

Merci pour tout.

Bien à vous,
Christian

 

[job75]

Re : Macro pour additionner des colonnes...

Bonjour Christian,

Avec la macro du post #3 :

r2(i) = Application.RoundUp(Application.Sum(Intersect(r1, r2(i).EntireRow)), 0)

Avec celle du post #5 (que je trouve préférable) :

r2 = "=ROUNDUP(SUM(" & Intersect(r1, r2(1).EntireRow).Address(0, 0, xlR1C1, , r2(1)) & "),0)"

A+

 

[Christian0258]

Re : Macro pour additionner des colonnes...

Re, le forum, job75,

Merci, job75, pour les solutions.
Effectivement, tu as raison,...encore...lol, je vais prendre la macro post5.

Bien à toi,
Christian

 

[job75]

Re : Macro pour additionner des colonnes...

Re,

Si l'on veut arrondir chaque valeur des colonnes F à L, modifier la macro du post #3 ainsi :

Sub Additionner()
Dim r1 As Range, r2 As Range, i&, s&, c As Range
On Error Resume Next
Set r1 = Application.InputBox("Sélectionnez les colonnes (F à L) à additionner :", "Addition", , , , , , 8)
Set r1 = Intersect(r1.EntireColumn, [F2:L65536], ActiveSheet.UsedRange)
If r1 Is Nothing Then Exit Sub
Set r2 = Application.InputBox("Sélectionnez la colonne (R à V) du résultat :", "Addition", , , , , , 8)
Set r2 = Intersect(r2(1).EntireColumn, [R2:V65536], ActiveSheet.UsedRange)
For i = 1 To r2.Count
  s = 0
  For Each c In Intersect(r1, r2(i).EntireRow)
    s = s + Application.RoundUp(c, 0)
  Next
  r2(i) = s
Next
End Sub

A+

 

[Christian0258]

Re : Macro pour additionner des colonnes...

Re, le forum, job75,

Ok, job75, impeccable, je vais appliquer cette macro.
Encore un grand merci pour tout ce que tu m'as fait...

Bien à toi

Christian