Somme de plusieurs colonne

Le
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/
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
DanielCo
Le #25219792
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
Albert
Le #25220232
Bonjour DanielCo
"DanielCo" 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




Albert
Le #25220282
Re Bonjour
"DanielCo" 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




Publicité
Poster une réponse
Anonyme