Sumproduct

cibleo

XLDnaute Impliqué
Bonsoir le forum,

La formule ci-dessous me fait la somme des montants de février situées en colonne E, les dates se trouvant en colonne A.
=SOMMEPROD((MOIS($A$2:$A$500)=2)*$E$2:$E$500)

En faisant un essai avec l'enregistreur de macro, j'obtiens ceci :
ActiveCell.FormulaR1C1 = "=SUMPRODUCT((MONTH(R2C1:R500C1)=2)*R2C5:R500C5)"
Dans le code ci-dessous, l'instruction en rouge me fait la somme de tous mes montants de l'année sans discerner les mois. Cela se fait de façon dynamique, ce code est une macro de Recherche. 2 totaux en colonne 4 et 5.

Comme vous le voyez, j'aimerais y rajouter 12 lignes d'instructions pour me faire un total pour chaque mois de l'année.
Code:
Private Sub CommandButton1_Click()
  Dim VSearch As String
  ShtR.[F4].Value = CmbChauffeurs.Value
  If CmbChauffeurs.Value = "" Then Exit Sub
  Application.ScreenUpdating = False
  x = 1
  VSearch = Me.CmbChauffeurs.Value
  For Each Ws In ThisWorkbook.Worksheets
    With Ws
      DerLiS = .Range("C65536").End(xlUp).Row
      If Left(.Name, 6) = "Caisse" Then
        i = Len(CmbChauffeurs.Value)
        For Each Cellule In .Range("C7:C" & DerLiS)
          If InStr(1, Cellule, VSearch, vbTextCompare) > 0 Then
              trouve = True
                DerLiR = ShtR.Range("A65536").End(xlUp).Row + 1
                For col = 1 To 5
                  ShtR.Cells(DerLiR, col).Value = Ws.Cells(Cellule.Row, col).Value
                Next
                [COLOR=blue]Total(1) = Total(1) + ShtR.Cells(DerLiR, [B]4[/B]).Value[/COLOR]
[COLOR=blue]Total(2) = Total(2) + ShtR.Cells(DerLiR, [B]5[/B]).Value[/COLOR]
                x = x + 1
            End If
        Next Cellule
      End If
     End With
  Next Ws
  For col = 4 To 5
    [COLOR=red]ShtR.Cells(DerLiR + 2, col).FormulaLocal = "=SOMME(" & ShtR.Cells(7, col).Address & ":" & ShtR.Cells(DerLiR, col).Address & ")"[/COLOR]
  Next
  [COLOR=blue]With ShtR.Cells(DerLiR + 2, 2)[/COLOR]
    [COLOR=blue].Value = "Total "[/COLOR]
    .HorizontalAlignment = xlRight
    .VerticalAlignment = xlCenter
  End With
  If trouve = False Then MsgBox "Pas de trace !"
  Unload Me
  Application.ScreenUpdating = True
End Sub

J'aimerais donc trouver la bonne formule pour ce calcul en me basant sur celle surlignée en rouge et d'autre part restructurer mon code en modifiant les parties en bleu si j'ai bien compris.

Si quelqu'un pouvait me trouver la solution pour 1 mois donné dans la formule et dans la structure de mon code, cela m'arrangerait, après je pense pouvoir me débrouiller pour le reste.:rolleyes:

Le code initial est dans le fichier joint dans le formulaire "Rechercher".
Celui présenté ci-dessus est une version légèrement modifié mais la structure est identique.

Merci de votre aide Cibleo
 

Pièces jointes

  • 2009V10.zip
    36.2 KB · Affichages: 84
  • 2009V10.zip
    36.2 KB · Affichages: 85
  • 2009V10.zip
    36.2 KB · Affichages: 86

Lii

XLDnaute Impliqué
Re : Sumproduct

Re,

si tu n'as pas d'erreur avec la couleur, ne change rien.
Pour n'avoir que le mot en rouge, avec le fichier fourni, je dois (et tu peux) passer par :
Code:
ShtR.Cells(DerLiR, 3).Characters(Start:=Pos, Length:=Len(VSearch)).Font.FontStyle = "normal"
ShtR.Cells(DerLiR, 3).Characters(Start:=Pos, Length:=Len(VSearch)).Font.ColorIndex = 3     'rouge
en supprimant les With et End With correspondants !
 

Gael

XLDnaute Barbatruc
Re : Sumproduct

Bonsoir à tous,

Merci Lii et bien vu, effectivement, j'avais remplacé la recherche inutile à chaque boucle de la dernière ligne mais l'initialisation du compteur était mal placée et bien sûr tests incomplets avec une seule feuille:(:mad:

Mais je ne rencontre pas d'erreur sur les lignes dont tu parles qui permettrent de mettre en rouge le mot recherché dans les libellés.

j'ai refait un test sur 2 feuilles qui marche très bien.

@+

Gael
 

cibleo

XLDnaute Impliqué
Re : Sumproduct

Bonsoir à tous,
Bonsoir Lii, Gael,

Simplement, pour vous confirmer que je n'ai rien changé au code initial concernant la mise en valeur du mot recherché dans le libellé, il s'affiche bien en rouge, aucun souci de ce côté là.

Par contre, je reviens sur le fil pour paramétrer le code de Gael pour une recherche dans mes Feuilles nommées "Caisse Mois09".

Dans le fichier ci-dessous, j'ai repris son code dans le formulaire "Mouvements".
La recherche se fait désormais dans la colonne C de toutes mes feuilles nommées "Caisse mois09" en choisissant les initiales d'un chauffeur dans la combobox.

Mais je n'arrive pas à faire les derniers petits réglages.

Ainsi, dans la feuille "Recherche1", lorsque je relance une recherche :

- les données précédentes (5 premières lignes) ne s'effacent pas.
- la valeur des sous-totaux égale à 0 apparait.
- la 1ère ligne de la feuille "Caisse Janv09" soit le Versement banque du 1/1/2008 apparait en derniére position :confused: dans le résultat de ma recherche avec "Jp" comme choix du chauffeur.

Bref, il y a de petites modifications à apporter, si vous pouviez m'aider, cela serait sympa.

Amicalement Cibleo
 

Pièces jointes

  • 2009version2.zip
    47.2 KB · Affichages: 47
  • 2009version2.zip
    47.2 KB · Affichages: 47
  • 2009version2.zip
    47.2 KB · Affichages: 47
Dernière édition:

Gael

XLDnaute Barbatruc
Re : Sumproduct

Bonjour Cibleo, Lii, bonjour à tous,

Quelques modifications mineures dans le fichier joint:

Code:
' Définir le nom de la feuille de RECHERCHE
  Set ShtR = Sheets("Recherche1")
  DerLiR = ShtR.Range("[COLOR=red]B[/COLOR]65536").End(xlUp).Row
  ShtR.Range("[COLOR=red]A2[/COLOR]:F" & DerLiR + 2).ClearContents
  ShtR.Range("[COLOR=red]D2[/COLOR]:F" & DerLiR + 2).NumberFormat = "#,##0.00 $"
  With ShtR.Range("[COLOR=red]B2[/COLOR]:B" & DerLiR + 2)

Il faut chercher la dernière ligne en colonne B puisqu'elle contient en plus les calculs mois par mois, ce qui fait 24 lignes de plus et commencer les plages en ligne 2 et pas en ligne 7 pour effacer aussi les 5 premières lignes.

Pour les 0, j'ai simplement rajouté une ligne en fin de macro pour ne pas afficher les valeurs à 0:

Code:
ActiveWindow.DisplayZeros = False

Il y a cependant d'autres solutions:

On peut n'afficher les calculs par mois que pour les mois qui ont un total différent de 0, dans ce cas on pourra avoir Janvier puis Mai et Septembre à la suite.
On peut dans les formules, ne rien mettre si le total est à 0, dans ce cas on aura tous les mois mais avec un "" si égal à 0.

Que veux-tu obtenir exactement pour les calculs mensuels?

@+

Gael
 

Pièces jointes

  • 2009version3.xls
    112.5 KB · Affichages: 95

cibleo

XLDnaute Impliqué
Re : Sumproduct

Bonjour à tous, bonjour Gael,

Ça marche pour les modifications ;) et suis d'accord pour n'afficher que les résultats dont les mois sont différents de 0.

Sinon, dessous j'ai voulu ajouté ces 2 lignes d'instructions pour bien discerner mes "Nombre Valeurs" de mes "Totaux" (Bleu pour le Nombre Valeurs Général ; rouge pour les Nbre Valeurs mensuels).

Mais cela n'a pas l'air de fonctionner lors de mes divers essais ---> les totaux aussi s'affichent parfois en rouge :(.
Que faut-il corriger ?
Code:
For col = 4 To 5
    .....
    .....    
    ShtR.Cells(DerLiR + 3, col).NumberFormat = "#,##0"
    ShtR.Cells(DerLiR + 3, col).HorizontalAlignment = xlCenter
    [B][COLOR=royalblue]ShtR.Cells(DerLiR + 3, col).Characters.Font.ColorIndex = 5[/COLOR][/B]

Code:
For i = 2 To 24 Step 2
    .....    
    .....    
    ShtR.Cells(DerLiR + 3 + i, col).NumberFormat = "#,##0"
    ShtR.Cells(DerLiR + 3 + i, col).HorizontalAlignment = xlCenter
    [COLOR=royalblue][B]ShtR.Cells(DerLiR + 3 + i, col).Characters.Font.ColorIndex = 3[/B][/COLOR]

Le top du top, ça serait d'intégrer ,dans la colonne F, la formule qui me calculerait le solde positif ou négatif en bout des lignes intitulées "Total", c'est à dire E - D.

Si c'était réalisable, ça serait génial.

Merci de ton aide Cibleo
 

Gael

XLDnaute Barbatruc
Re : Sumproduct

Bonjour à tous,

Une version 4 qui devrait répondre à tes attentes.

J'ai modifié quelques dates pour le chauffeur JP afin d'avoir des mois différents à traiter.

Comme l'avait proposé Excel_lent, j'ai mis les valeurs par mois et non pas les formules. C'est plus simple à gérer et s'agissant d'une feuille temporaire dont les montants ne sont pas destinés à être modifiés, les formules ne sont pas toujours utiles. Cependant, si tu le souhaites, tu peux facilement remettre les formules.

@+

Gael
 

Pièces jointes

  • 2009version4.xls
    119 KB · Affichages: 89

cibleo

XLDnaute Impliqué
Re : Sumproduct

Bonsoir à tous, bonsoir Gael,

De passage pour te dire que je décortique ton code et y apporte quelques petites touches au niveau de l'aspect visuel des sous-totaux.

Je change simplement les différents attributs des caractères, cela me permet de comprendre la structure de ton code, c'est déjà pas mal :rolleyes:.

Sinon, je t'avais signalé le petit souci ci-dessous : (Faire l'essai avec la version 3 et non 4)

- la 1ère ligne de la feuille "Caisse Janv09" soit le Versement banque du 1/1/2008 apparait en derniére position :confused: dans le résultat de ma recherche avec "Jp" comme choix du chauffeur

Je pense l'avoir résolu en remplaçant C7 par C6. (Voir la rectification en dessous).
Code:
For Each Ws In ThisWorkbook.Worksheets
    With Ws
      DerLiS = .Range("C65536").End(xlUp).Row
      If Left(.Name, 6) = "Caisse" Then
    Set plage = .Range("[B][COLOR=royalblue]C6[/COLOR][/B]:C" & DerLiS)

Autre petit souci : lors de recherches successives, mes nouvelles données apparaissant en colonne F (Solde) prennent la couleur et l'alignement des sous totaux qui pouvaient figurer dans ces mêmes cellules avant la nouvelle recherche.

Il y a un problème d'effacement en quelque sorte.

En attendant la petite modification à effectuer, je continue à explorer ton code et reviendrai te donner des nouvelles et sûrement de nouvelles questions.

A+ Cibleo
 
Dernière édition:

Lii

XLDnaute Impliqué
Re : Sumproduct

Bonsoir Tous,

une petite correction pour éliminer le second problème :
Code:
   ...
   ShtR.Range("A2:F" & DerLiR + 2).[B]Clear[/B]
    ...
End Sub

ClearComments
n'efface que le contenu alors que Clear efface tout mises en forme comprises.
Effectivement C6 permet de résoudre le premier problème.
 

cibleo

XLDnaute Impliqué
Re : Sumproduct

Bonsoir à tous,
Bonsoir Lii, Gael,

Je continue l'analyse du code et j'avoue piger de moins en moins la structure et le contenu des boucles.

Notamment ceci : j = 3
et cela : ShtR.Cells(DerLiR + j - 1, 2).

Sinon, j'aimerais rajouter une condition sur le format des soldes en colonne F dans la partie du code ci-dessous.

Si solde négatif : NumberFormat = "- #,##0.00 $"
Si solde positif : NumberFormat = "+ #,##0.00 $"

De plus, j'aimerais calculer le solde seulement au niveau de mon total et de mes sous-totaux, le calcul des soldes au niveau des lignes reportées n'est vraiment pas utile.

De plus en plus exigeant Cibleo :rolleyes: mais je vous rassure, je ne suis jamais pressé pour les réponses.

Code:
If col = 4 Then
....
....
ShtR.Cells(DerLiR + j - 1, 6).NumberFormat = "- #,##0.00 $"
ShtR.Cells(DerLiR + j - 1, 6).NumberFormat = "+ #,##0.00 $"

Si vous pouviez une nouvelle fois intervenir :cool:

Pour Lii :
L'utilisation de Clear efface la bordure droite de la colonne F et les nouvelles données perdent leur alignement initial :(

Amicalement Cibleo
 

Excel-lent

XLDnaute Barbatruc
Re : Sumproduct

Bonsoir Cibleo, le fil, tout le monde

cibleo à dit:
L'utilisation de Clear efface la bordure droite de la colonne F et les nouvelles données perdent leur alignement initial :(

Tu n'as pas essayé de remplacer :
ShtR.Range("A2:F" & DerLiR + 2).Clear
par :
ShtR.Range("A2:F" & DerLiR + 2).ClearComments

comme indiqué par Lii?

cibleo à dit:
Sinon, j'aimerais rajouter une condition sur le format des soldes en colonne F dans la partie du code ci-dessous.

Si solde négatif : NumberFormat = "- #,##0.00 $"
Si solde positif : NumberFormat = "+ #,##0.00 $"

Range("ta cellule ou zone").Select
Selection.NumberFormat = " + #,##0.00" "$;- #,##0.00" "$"

Attention, pour que ce code fonctionne, il faut que ton Excel soit au format américain, c'est à dire que dans : "Outils" / "Options..." / Onglet '"International" :
en séparateur de décimal tu dois avoir : le point
en séparateur de millier tu dois avoir : la virgule

Bonne continuation.
 
Dernière édition:

Gael

XLDnaute Barbatruc
Re : Sumproduct

Bonjour à tous,

Ci-joint une version avec les modifications souhaitées.

Notamment ceci : j = 3
et cela : ShtR.Cells(DerLiR + j - 1, 2)

Comme les mois ne sont pas tous utilisés, il faut un compteur indépendant pour savoir sur quelle ligne on doit écrire en fonction des mois déjà inscrits. Dans la formule précédente, on pouvait utiliser "i" qui variait de 1 à 12 selon le mois.

J=3 puisque le premier mois commence à la dernière ligne + 1 ligne blanche + 1 ligne "Total" et une ligne "Nbre de valeurs" = DerliR +3

A chaque ligne écrite, on fait J=J+1 pour la ligne suivante.

Si le n° de colonne est 4 (Col=4) on va écrire les titres "Total mois xxx" et "nombre de valeurs", mais comme on a déjà écrit le total mois et le nbre de valeurs (soit 2 lignes), il faut écrire "Total mois xxx" à la ligne précédente soit j-1 puis "nbre de valeurs" à la ligne j.

@+

Gael
 

Pièces jointes

  • 2009version5.xls
    119.5 KB · Affichages: 64

cibleo

XLDnaute Impliqué
Re : Sumproduct

Bonsoir le forum,
Bonsoir Excel-lent, Lii, Gael,

De retour pour vous signaler que j'ai enregistré vos petites modifications.

Lii, Excel-lent, j'ai remplacé .ClearContents par Clear, c'est OK.
Les formats, c'est tout bon Gael, merci pour tes commentaires avisés mais c'est vraiment dur, dur !

Par contre, n'apparait pas de bordure droite dans la colonne F. Puisqu'une fois les données effacées, ne sont recopiées que les colonnes 1 à 5.

Si je mets 6 à la place du 5, je récupère bien ma bordure droite en colonne F, mais le problème, c'est que je récupère aussi les valeurs en colonne F des mes feuilles "Caisse" :confused:, ce que je ne souhaite pas.

Je laisse donc le 5, mais s'il faut rajouter une ligne d'instructions pour m'afficher cette bordure, n'hésiter pas à intervenir.
Code:
Do
            DerLiR = DerLiR + 1
            [COLOR=darkred]Range(Ws.Cells(Cel.Row, 1), Ws.Cells(Cel.Row, [B][COLOR=red]5[/COLOR][/B])).Copy[/COLOR]
            ShtR.Cells(DerLiR, 1).Select
            ActiveSheet.Paste

D'autre part, pour bien distinguer mes lignes reportées, j'aimerais appliquer une bordure s'appliquant de mes colonnes A à F, lorsqu'il y a un changement de mois dans ma colonne A.

Une mise en forme conditionnelles en quelque sorte, si Mois(A2) différent de Mois(A3) alors une bordure placée en bas de A2 à F2.
De ce style :
Code:
With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
End With

Merci de votre aide Cibleo

Bonne soirée à tous.
 

Staple1600

XLDnaute Barbatruc
Re : Sumproduct

Bonsoir à tous

Un petit passage

pour une petite suggestion

Code:
[FONT=Courier New][COLOR=green]' cela fonctionne aussi non ?[/COLOR]
[COLOR=darkblue]Do[/COLOR]
    DerLiR = DerLiR + 1
    Range(Ws.Cells(Cel.Row, 1), Ws.Cells(Cel.Row, 5)).Copy ShtR.Cells(DerLiR, 1)[/FONT]
 

Gael

XLDnaute Barbatruc
Re : Sumproduct

Bonjour à tous,

Ci-joint une version avec les modifs demandées, incluant la remarque de Staple qui fonctionne effectivement très bien.

Pour les formats, c'est finalement plus simple de laisser le Clearcontents et de gérer l'effacement ou la mise en place des formats souhaités.

J'ai rajouté une ligne à la fin pour séparer les données des totaux que tu peux enlever si tu préfères.

@+

Gael
 

Pièces jointes

  • 2009version6.zip
    44.4 KB · Affichages: 58
Dernière édition:

cibleo

XLDnaute Impliqué
Re : Sumproduct

Bonjour Gael, Staple1600 et le forum,

Staple, je n'avais pas bien saisi le sens de ta remarque, mais en bouquinant la bible de John Walkenbach "VBA pour Excel 2003", je suis tombé, pages 913 et 914, sur la même reflexion.

En résumé, il dit que la méthode Select pouvait inutilement ralentir une macro et qu'elle pouvait être remplacée par une instruction plus simple.

Bravo Staple, j'en déduis que notre ami John a de bons professeurs sur ce forum :D

Sinon Gael, je continue à décortiquer ton code et l'adapter à mon fichier original.

Laisse moi le temps de souffler, j'ai du mal à te suivre.

Toujours avec ton code, je vais revenir poser une question d'ici quelques jours, le temps de la rédiger.

Merci à vous tous Cibleo
 

Discussions similaires

Statistiques des forums

Discussions
312 231
Messages
2 086 441
Membres
103 210
dernier inscrit
Bay onais