Sumproduct

[cibleo]

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.

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.

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

 

[cibleo]

Re : Sumproduct

Bonsoir à tous,
Bonsoir Gael,

Voilà, j'aimerais finaliser cette petite application.

Pour bien comprendre ma nouvelle demande, j'ai placé dans la feuille de calcul "Recherche1", 4 CommandButton. (Choix 1, 2, 3 et 4)

Les choix 1 et 2 reprennent le code de Gael, seules les lignes suivantes diffèrent dans le choix 2.

....
[COLOR=red]With ComboChauffeurs[/COLOR]
[COLOR=red].AddItem "Fa"[/COLOR]
[COLOR=red].AddItem "Sc"[/COLOR]
[COLOR=red].AddItem "Jo"[/COLOR]
[COLOR=red].AddItem "Ju"[/COLOR]
[COLOR=red].AddItem "Sy"[/COLOR]
[COLOR=red].AddItem "Jp"[/COLOR]
[COLOR=red]End With[/COLOR]
....
....
ShtR[COLOR=red].[G1].[/COLOR]Value = [COLOR=red]ComboChauffeurs.Value[/COLOR]
  [COLOR=red]If ComboChauffeurs.Value[/COLOR] = "" Then Exit Sub
 
  VSearch = [COLOR=red]Me.ComboChauffeurs.Value[/COLOR]
....
....
For Each Ws In ThisWorkbook.Worksheets
    With Ws
      [COLOR=red]DerLiS = .Range("C65536").End(xlUp).Row[/COLOR]
      If Left(.Name, 6) = "Caisse" Then
    [COLOR=red]Set plage = .Range("C6:C" & DerLiS)[/COLOR]
....
....
Pos = InStr(1, ShtR.Cells[COLOR=red](DerLiR, 3).[/COLOR]Text, VSearch, vbTextCompare)
 
        With ShtR.Cells[COLOR=red](DerLiR, 3).[/COLOR]Characters(Start:=Pos, Length:=Len(VSearch)).Font
        .FontStyle = "normal"
        .ColorIndex = 3     'rouge
        End With
....

Pour le choix 1, la recherche se fait en colonne C.
Pour le choix 2, la recherche se fait en colonne B.

J'aimerais désormais combiner ces 2 codes pour effectuer une recherche simultanée en colonne B et C.

Pour cela , j'ai créé le bouton "Choix 3" dont le formulaire (Mouvements2) contient la ComboBox (ComboChauffeurs) et la TextBox (TextBoxMot) des choix 1 et 2.

J'ai aussi créé le bouton "Choix 4" où sont placés la Combobox, la TextBox et 2 CheckBox, l'idéal serait alors d'effectuer les choix en cochant les CheckBox ( soit la 1, la 2 ou la 1 et 2).

Si l'on devait ne retenir que le choix 4, les boutons 1, 2 et 3 disparaitraient naturellement.

Si vous pouviez m'aider à combiner ces 2 codes, ça serait hyper sympa.

Je vous joint mon fichier dans le lien ci-dessous.

Cijoint.fr - Service gratuit de dépôt de fichiers

Merci de votre aide et bonne soirée à tous.

Cibleo

 

[klin89]

Re : Sumproduct

Bonsoir à tous,

Une petite incursion pour poser une question aux habitués du forum et spécialistes en VBA.

Pourquoi le fichier joint dans le lien Cijoint.fr affiche t-il une erreur d'exécution '1004' lorsque j'éxécute sa macro directement à partir du lien ---> j'ouvre le fichier sans l'enregistrer, je clique sur 1 des 4 boutons et valide l'entrée de la ComboBox.

L'instruction ci-dessous apparaît surlignée en jaune.

L'erreur ---> La méthode Select de la classe Range a échoué

Range(ShtR.Cells(DerLiR - 1, 1), ShtR.Cells(DerLiR - 1, 6)).Select

Par contre, en l'enregistrant sur mon disque dur, la macro fonctionne à merveille, il n'y a pas d'erreur d'éxécution.

Bizarre, y a t-il une explication, rencontrez-vous souvent ce problème.

Klin89

 

[jeanpierre]

Re : Sumproduct

Bonsoir klin89, le fil,

Je viens d'ouvrir en direct (je n'enregistre jamais sur mon disque, sauf si je dois renvoyer le fichier modifié) et pas l'erreur annoncée.

J'ai testé aussi les 4 boutons (sauf que sur mon pc c'est assez lent), ormis cela, pas de problème particulier.

Renseigne ta version d'Excel dans ton pseudo... ça peut aider quelquefois.

Bonne soirée.

Jean-Pierre