Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Somme de plusieurs colonne

Somme de plusieurs colonne

3 réponses
Avatar
Albert
Bonjour

Fichier exemple sur http://cjoint.com/?CBmuapB1Sxe

J'aimerais automatiser (ou améliorer) la création des formules dans les
cellules AL3, AM3, AN3 et AO3, pour faire la somme des présences de chaque
sujet, et ensuite les trainer jusqu'à bas.
Actuellement on clique sur chaque cellule de la ligne 3 selon la couleur en
maintenant la touche Control pressée.
Ceci se fait habituellement en début de saison, mais il y a toujours des
revisions et il faut tout recommencer.
Le fichier contient 650 lignes et 80 colonnes.

Vos suggestions seront appréciées


--
Albert
albertri@videotron.ca
http://persocite.francite.com/alber1/
http://pages.videotron.com/alber/
Signaler un problème avec ce contenu

3 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
DanielCo
Bonjour,
En neutralisant la macro "Worksheet_Change" de Feuil1" :

Sub Recalcul()
Dim DerLigne As Long, C As Range
With Sheets("Feuil1")
DerLigne = Application.Match("Rencontres", .[B:B], 0) - 2
.Range(.[AL3], .Cells(DerLigne, "AO")).ClearContents
For Each C In .Range(.[AL3], .Cells(DerLigne, "AL"))
For i = 3 To 36
If .Cells(C.Row, i) <> "" Then
If .Cells(C.Row, i).Interior.Color =
.[AL2].Interior.Color Then
C.Value = C.Value + .Cells(C.Row, i).Value
ElseIf .Cells(C.Row, i).Interior.Color =
.[AM2].Interior.Color Then
C.Offset(, 1).Value = C.Offset(, 1).Value +
.Cells(C.Row, i).Value
ElseIf .Cells(C.Row, i).Interior.Color =
.[AN2].Interior.Color Then
C.Offset(, 2).Value = C.Offset(, 2).Value +
.Cells(C.Row, i).Value
Else
C.Offset(, 3).Value = C.Offset(, 3).Value +
.Cells(C.Row, i).Value
End If
End If
Next i
Next C
End With
End Sub

Cordialement.
Daniel


Bonjour

Fichier exemple sur http://cjoint.com/?CBmuapB1Sxe

J'aimerais automatiser (ou améliorer) la création des formules dans les
cellules AL3, AM3, AN3 et AO3, pour faire la somme des présences de chaque
sujet, et ensuite les trainer jusqu'à bas.
Actuellement on clique sur chaque cellule de la ligne 3 selon la couleur en
maintenant la touche Control pressée.
Ceci se fait habituellement en début de saison, mais il y a toujours des
revisions et il faut tout recommencer.
Le fichier contient 650 lignes et 80 colonnes.

Vos suggestions seront appréciées
Avatar
Albert
Bonjour DanielCo
"DanielCo" a écrit dans le message de
news:kfe8m7$5es$

Merci cela fonctionne bien et je crois qu'il me sera possible de l'adapter
au classeur actuel.
J'ai désactivé Worksheet_Change pour cette plage.
Quand je remplace les Cellules AL3 etc. par BO3 BP3 BQ3 et BR tout
fonctionne, et j'ai ajouté le tout à la suite de Sub MisaJourFormules()
et la les valeurs 3 to 36 par 3 to Colonne2 (variable pour la derniere
colonne de la plage).
mais pour le présent j'ai de la difficulté a adapter les autres variables
pour l'inserttion/suppression de colonne.

La nuit porte conseil, je reviendrai

merci
albert




Bonjour,
En neutralisant la macro "Worksheet_Change" de Feuil1" :

Sub Recalcul()
Dim DerLigne As Long, C As Range
With Sheets("Feuil1")
DerLigne = Application.Match("Rencontres", .[B:B], 0) - 2
.Range(.[AL3], .Cells(DerLigne, "AO")).ClearContents
For Each C In .Range(.[AL3], .Cells(DerLigne, "AL"))
For i = 3 To 36
If .Cells(C.Row, i) <> "" Then
If .Cells(C.Row, i).Interior.Color =
.[AL2].Interior.Color Then
C.Value = C.Value + .Cells(C.Row, i).Value
ElseIf .Cells(C.Row, i).Interior.Color =
.[AM2].Interior.Color Then
C.Offset(, 1).Value = C.Offset(, 1).Value +
.Cells(C.Row, i).Value
ElseIf .Cells(C.Row, i).Interior.Color =
.[AN2].Interior.Color Then
C.Offset(, 2).Value = C.Offset(, 2).Value +
.Cells(C.Row, i).Value
Else
C.Offset(, 3).Value = C.Offset(, 3).Value +
.Cells(C.Row, i).Value
End If
End If
Next i
Next C
End With
End Sub

Cordialement.
Daniel


Bonjour

Fichier exemple sur http://cjoint.com/?CBmuapB1Sxe

J'aimerais automatiser (ou améliorer) la création des formules dans les
cellules AL3, AM3, AN3 et AO3, pour faire la somme des présences de
chaque sujet, et ensuite les trainer jusqu'à bas.
Actuellement on clique sur chaque cellule de la ligne 3 selon la couleur
en maintenant la touche Control pressée.
Ceci se fait habituellement en début de saison, mais il y a toujours des
revisions et il faut tout recommencer.
Le fichier contient 650 lignes et 80 colonnes.

Vos suggestions seront appréciées




Avatar
Albert
Re Bonjour
"DanielCo" a écrit dans le message de
news:kfe8m7$5es$

J'ai réussi à intégrer votre macro à la macro existante et le tout
fonctionne très bien.
J'ai simplement ajouté la macro à la fin de Sub MisaJourFormules() en
ajoutant un apostrophe à 'End Sub et à 'Sub Recalcul()
et en ajoutant les variables nécessaires pour compenser l'ajout et la
suppression de colonne.

Ci-bas la macro modifiée

Merci
Albert

Sub MisaJourFormules()
' Modifié février 2013 par Albert
' anciennement -jj_3()
' Macro pour mettre à jour les formules qui comptabilisent les présences,
' après les ajouts/suppressions de membres.
' Création de la macro par (jj) Jacky de EXCEL 8 novembre 2011 (jar)
Dim LaColonne As Long, Lacolonne2 As Long, LaLigne As Long, LaLigne2 As
Long, LaLigne3 As Long
Dim T As Double, F As Double, R As Double
T = Timer
Beep
LaLigne = Application.Match("RENCONTRES", [B:B], 0) - 2 ' No de ligne, 2
lignes au dessus du mot Rencontres
LaColonne = Application.Match("TOTAL", [2:2], 0) ' No de la colonne avec
le mot TOTAL
Lacolonne2 = Application.Match("TOTAL", [2:2], 0) - 2 ' No de la colonne, 2
colonnes à gauche mot TOTAL sur la deuxième ligne
LaLigne2 = Application.Match("RENCONTRES", [B:B], 0) ' No de la ligne du mot
Rencontres colonne B
LaLigne3 = Application.Match("VISITEURS", [B:B], 0) ' No de ligne du mot
VISITEURS colonne B


Range(Cells(3, LaColonne), Cells(LaLigne, LaColonne)).Formula = "=sum(" &
Range(Cells(3, 3), Cells(3, Lacolonne2)).Address(0, 0) & ")"
Range(Cells(LaLigne2, 3), Cells(LaLigne2, Lacolonne2)).Formula = "=sum(" &
Range(Cells(3, 3), Cells(LaLigne, 3)).Address(0, 0) & ")"
Range(Cells(LaLigne2 + 2, 3), Cells(LaLigne2 + 2, Lacolonne2)).Formula =
"=sum(" & Range(Cells(3, 3), Cells(LaLigne3 - 2, 3)).Address(0, 0) & ")"
Range(Cells(LaLigne2 + 3, 3), Cells(LaLigne2 + 3, Lacolonne2)).Formula =
"=sum(" & Range(Cells(LaLigne3 + 2, 3), Cells(LaLigne, 3)).Address(0, 0) &
")"
Cells(LaLigne2, LaColonne).Formula = "=sum(" & Range(Cells(3, LaColonne),
Cells(LaLigne, LaColonne)).Address(0, 0) & ")"
Cells(LaLigne2, LaColonne - 1).Formula = "=sum(" & Range(Cells(LaLigne2, 3),
Cells(LaLigne2, Lacolonne2)).Address(0, 0) & ")"
Cells(LaLigne2 + 2, LaColonne - 1).Formula = "=sum(" & Range(Cells(LaLigne2
+ 2, 3), Cells(LaLigne2 + 2, Lacolonne2)).Address(0, 0) & ")"
Cells(LaLigne2 + 3, LaColonne - 1).Formula = "=sum(" & Range(Cells(LaLigne2
+ 3, 3), Cells(LaLigne2 + 3, Lacolonne2)).Address(0, 0) & ")"
Range(Cells(LaLigne2, LaColonne + 1), Cells(LaLigne2, LaColonne +
4)).Formula = _
"=sum(" & Range(Cells(3, LaColonne + 1), Cells(LaLigne, LaColonne +
1)).Address(0, 0) & ")"
Cells(LaLigne2 + 1, LaColonne + 4).Formula = "=sum(" & Range(Cells(3,
LaColonne + 1), Cells(LaLigne, LaColonne + 4)).Address(0, 0) & ")"
Range(Cells(LaLigne2 + 1, 3), Cells(LaLigne2 + 1, Lacolonne2)).Formula =
"=IF(COUNT(" & Range(Cells(3, 3), Cells(LaLigne, 3)).Address(0, 0) &
"),1,""""" & ")"
Cells(LaLigne2 + 1, LaColonne - 1).Formula = "=sum(" & Range(Cells(LaLigne2
+ 1, 3), Cells(LaLigne2 + 1, Lacolonne2)).Address(0, 0) & ")"
Cells(LaLigne2 + 1, LaColonne).Formula = "=sum(" & Range(Cells(3, 3),
Cells(LaLigne, Lacolonne2)).Address(0, 0) & ")"
Range(Cells(3, 1), Cells(LaLigne3 - 2, 1)).Font.Name = "Wingdings"
Range(Cells(3, 1), Cells(LaLigne3 - 2, 1)).Value = "¡" ' 0x9A caractère
wingding
'End Sub
'Sub Recalcul() 'par DanielCo 2013-02-12
Dim DerLigne As Long, C As Range
With Sheets("Feuil1")
DerLigne = Application.Match("Rencontres", .[B:B], 0) - 2
.Range(.Cells(3, LaColonne + 1), .Cells(DerLigne, LaColonne +
4)).ClearContents
For Each C In .Range(.Cells(3, LaColonne + 1),
.Cells(DerLigne, LaColonne + 1))
For i = 3 To Lacolonne2
If .Cells(C.Row, i) <> "" Then
If .Cells(C.Row, i).Interior.Color = .Cells(2, LaColonne
+ 1).Interior.Color Then
C.Value = C.Value + .Cells(C.Row, i).Value
ElseIf .Cells(C.Row, i).Interior.Color = .Cells(2,
LaColonne + 2).Interior.Color Then
C.Offset(, 1).Value = C.Offset(, 1).Value +
.Cells(C.Row, i).Value
ElseIf .Cells(C.Row, i).Interior.Color = .Cells(2,
LaColonne + 3).Interior.Color Then
C.Offset(, 2).Value = C.Offset(, 2).Value +
.Cells(C.Row, i).Value
Else
C.Offset(, 3).Value = C.Offset(, 3).Value +
.Cells(C.Row, i).Value
End If
End If
Next i
Next C
End With
F = Timer
R = F - T
'Cells(1, 2) = R
End Sub




Bonjour,
En neutralisant la macro "Worksheet_Change" de Feuil1" :

Sub Recalcul()
Dim DerLigne As Long, C As Range
With Sheets("Feuil1")
DerLigne = Application.Match("Rencontres", .[B:B], 0) - 2
.Range(.[AL3], .Cells(DerLigne, "AO")).ClearContents
For Each C In .Range(.[AL3], .Cells(DerLigne, "AL"))
For i = 3 To 36
If .Cells(C.Row, i) <> "" Then
If .Cells(C.Row, i).Interior.Color =
.[AL2].Interior.Color Then
C.Value = C.Value + .Cells(C.Row, i).Value
ElseIf .Cells(C.Row, i).Interior.Color =
.[AM2].Interior.Color Then
C.Offset(, 1).Value = C.Offset(, 1).Value +
.Cells(C.Row, i).Value
ElseIf .Cells(C.Row, i).Interior.Color =
.[AN2].Interior.Color Then
C.Offset(, 2).Value = C.Offset(, 2).Value +
.Cells(C.Row, i).Value
Else
C.Offset(, 3).Value = C.Offset(, 3).Value +
.Cells(C.Row, i).Value
End If
End If
Next i
Next C
End With
End Sub

Cordialement.
Daniel


Bonjour

Fichier exemple sur http://cjoint.com/?CBmuapB1Sxe

J'aimerais automatiser (ou améliorer) la création des formules dans les
cellules AL3, AM3, AN3 et AO3, pour faire la somme des présences de
chaque sujet, et ensuite les trainer jusqu'à bas.
Actuellement on clique sur chaque cellule de la ligne 3 selon la couleur
en maintenant la touche Control pressée.
Ceci se fait habituellement en début de saison, mais il y a toujours des
revisions et il faut tout recommencer.
Le fichier contient 650 lignes et 80 colonnes.

Vos suggestions seront appréciées