Erreur dans la fonction SumIfs

akni · 2 Juillet 2017

Bonsoir,
La fonction Sumifs dans vba fonctionne correctement mais quand j'associe à un critère 2 données (exemple ci dessous "Array("A","D")) j'ai toujours le message d'incompatibilité de type.

Merci beaucoup pour toute aide.

Sheets("feuil1").Cells(2, 5).Value = WorksheetFunction.Sum(WorksheetFunction.SumIfs(Sheets_("feuil1").Range("c4:c514"), Sheets("feuil1").Range("b4:b514"), Array("A", "D")))

job75 · 5 Juillet 2017

Bonjour akni, le forum,

S'il y a beaucoup de clients (par exemple 10000) il y aura autant de formules à entrer en colonne I.

Et leur calcul prendra alors beaucoup de temps.

Avec cette macro on n'entre plus de formules, c'est bien plus rapide :

Code:

Private Sub Worksheet_SelectionChange(ByVal r As Range)
Dim derlig&, liste, ub&, d As Object, tablo, i&, j&, x$
derlig = Range("H" & Rows.Count).End(xlUp).Row
If derlig < 4 Then Range("H4:I" & Rows.Count).Delete xlUp: Exit Sub
Set r = Intersect(r, Range("H4:H" & derlig))
If r Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Range("H4:H" & Rows.Count).Interior.ColorIndex = xlNone 'RAZ
Range("I4:I" & Rows.Count) = "" 'RAZ
'---stockage en colonne J (masquée)---
[J:J] = "" 'RAZ
If...

Lone-wolf · 2 Juillet 2017

Bonjour akni

Peut-être comme ceci

VB:

Sub test()
Dim tot As Long, col As Range

    With Sheets("feuil1")
        Set col = .Range("A:D").Columns
        tot = WorksheetFunction.Sum(WorksheetFunction.SumIfs _
        (.Range("c4:c514"), .Range("b4:b514"), col))
        .Cells(2, 5).Value = tot
    End With
End Sub

akni · 2 Juillet 2017

Bonjour Lone-wolf,
Merci pour la réponse mais peut être je me suis mal exprimé les critères "A" et "D" ne font pas référence à des colonnes mais correspondent aux données dans la colonne B.

Ci joint le fichier et merci bcp.

akni · 3 Juillet 2017

Bonsoir,

Je cherche l'équivalent de la formule d'Excel ci dessous dans le code VBA.

=SOMME(SOMME.SI.ENS(C4:C517;A4:A517;G4;B4:B517;{"A";"S"}))

Merci pour toute aide

job75 · 3 Juillet 2017

Bonjour akni, Lone-wolf, le forum,

Le calcul est en mode Manuel, mettez-le en Automatique ! Onglet Fichier => Options => Formules.

Pour le VBA le plus simple est d'entrer la formule Excel avec des plages illimitées :

Code:

Sub Test()
With Sheets("Feuil1")
  With .Range("H4:H" & .Range("G" & .Rows.Count).End(xlUp).Row + 3)
    .Formula = "=SUM(SUMIFS(C:C,A:A,G4,B:B,{""A"";""S""}))"
    .Value = .Value 'supprime les formules
    .Replace 0, "", xlWhole 'facultatif, supprime les valeurs zéro
  End With
End With
End Sub

Edit : j'ai mis + 3 pour le cas où l'on efface toute la colonne G, ce n'est pas indispensable.

A+

akni · 3 Juillet 2017

Merci beaucoup Job75,
C'est formidable c'est vraiment le code que je cherchais.

Encore une fois un grand Merci.

job75 · 3 Juillet 2017

Re,

Une macro plus élaborée qui permet de sélectionner tous les articles que l'on veut :

Code:

Private Sub Worksheet_SelectionChange(ByVal r As Range)
Set r = Intersect(r, Range("J4", Range("J" & Rows.Count).End(xlUp)))
If r Is Nothing Then Exit Sub
Dim t$
For Each r In r
  t = t & ";""" & r & """" 'concaténation des articles
  Next
t = "{" & Mid(t, 2) & "}"
ThisWorkbook.Names.Add "Liste", Evaluate(t) 'nom défini pour la MFC
With Range("H4:H" & Range("G" & Rows.Count).End(xlUp).Row + 3)
  .Formula = "=SUM(SUMIFS(C:C,A:A,G4,B:B," & t & "))"
  .Value = .Value 'supprime les formules
  .Replace 0, "", xlWhole 'facultatif, supprime les valeurs zéro
End With
End Sub

Fichier joint.

A+

job75 · 4 Juillet 2017

Bonjour akni, le forum,

Une solution plus complète avec un bouton pour la mise à jour des colonnes G H I :

Code:

Private Sub CommandButton1_Click() 'MAJ
Dim d1 As Object, d2 As Object, tablo, i&, r As Range, e, s As Range
Application.ScreenUpdating = False
Application.Goto [A1], True 'cadrage
Range("G4:I" & Rows.Count).Delete xlUp 'RAZ
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
d2.CompareMode = vbTextCompare 'la casse est ignorée
tablo = Range("A4:B" & Range("A" & Rows.Count).End(xlUp).Row + 3) 'matrice, plus rapide
For i = 1 To UBound(tablo)
  If tablo(i, 1) <> "" And tablo(i, 2) <> "" Then d1(tablo(i, 1)) = "": d2(tablo(i, 2)) = ""
Next i
If d1.Count Then [G4].Resize(d1.Count) = Application.Transpose(d1.keys) 'Transpose limitée à 65536 lignes
If d2.Count Then
  Set r = [H4].Resize(d2.Count)
  r = Application.Transpose(d2.keys) 'Transpose limitée à 65536 lignes
  r(0).Resize(r.Count + 1).Sort r, xlAscending, Header:=xlYes 'tri
  If IsArray([Liste]) Then
    d2.RemoveAll 'RAZ
    For Each e In [Liste]: d2(e) = "": Next e
    For Each r In r
      If d2.exists(r.Value) Then Set s = Union(IIf(s Is Nothing, r, s), r)
    Next r
    If Not s Is Nothing Then s.Select: [A1].Select 'lance Worksheet_SelectionChange
  End If
End If
End Sub

A utiliser si l'on modifie les données en colonnes A B C.

Avec les 2 Dictionary et un tableau VBA cette macro est très rapide.

J'ai aussi modifié légèrement la macro Worksheet_SelectionChange (il n'y a plus de MFC).

Fichier (2).

A+

job75 · 5 Juillet 2017

Bonjour akni, le forum,

S'il y a beaucoup de clients (par exemple 10000) il y aura autant de formules à entrer en colonne I.

Et leur calcul prendra alors beaucoup de temps.

Avec cette macro on n'entre plus de formules, c'est bien plus rapide :

Code:

Private Sub Worksheet_SelectionChange(ByVal r As Range)
Dim derlig&, liste, ub&, d As Object, tablo, i&, j&, x$
derlig = Range("H" & Rows.Count).End(xlUp).Row
If derlig < 4 Then Range("H4:I" & Rows.Count).Delete xlUp: Exit Sub
Set r = Intersect(r, Range("H4:H" & derlig))
If r Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Range("H4:H" & Rows.Count).Interior.ColorIndex = xlNone 'RAZ
Range("I4:I" & Rows.Count) = "" 'RAZ
'---stockage en colonne J (masquée)---
[J:J] = "" 'RAZ
If r.Count > 100 Then 'limite
  Set r = Range("H4:H" & derlig) 'on sélectionne tout
Else
  r.Copy [J1]
  liste = [J1].Resize(r.Count, 2) 'matrice, plus rapide, au moins 2 éléments
  ub = UBound(liste)
End If
r.Interior.ColorIndex = 44 'orange
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
'---tableau source---
tablo = Range("A4:C" & Range("A" & Rows.Count).End(xlUp).Row + 3) 'matrice, plus rapide
For i = 1 To UBound(tablo)
  If tablo(i, 1) <> "" And tablo(i, 2) <> "" And tablo(i, 3) <> "" Then
    If ub Then
      For j = 1 To ub
        If tablo(i, 2) = liste(j, 1) Then
          x = tablo(i, 1) & Chr(1) & liste(j, 1) 'concaténation avec séparateur
          d(x) = d(x) + tablo(i, 3) 'somme
        End If
      Next j
    Else
      x = tablo(i, 1)
      d(x) = d(x) + tablo(i, 3) 'somme
    End If
  End If
Next i
'---tableau des résultats---
With Range("G4:I" & Range("G" & Rows.Count).End(xlUp).Row + 3)
  tablo = .Value 'matrice, plus rapide
  For i = 1 To UBound(tablo)
    If ub Then
      For j = 1 To ub
        x = tablo(i, 1) & Chr(1) & liste(j, 1) 'concaténation avec séparateur
        If d.exists(x) Then tablo(i, 3) = tablo(i, 3) + d(x)
      Next j
    Else
      x = tablo(i, 1)
      If d.exists(x) Then tablo(i, 3) = d(x)
    End If
  Next i
  .Columns(3) = Application.Index(tablo, , 3) 'restitution en colonne I
End With
End Sub

La liste des articles sélectionnés est maintenant stockée en colonne J (masquée).

J'ai aussi adapté la macro du bouton à cette nouvelle méthode.

Fichier (3).

A+

Erreur dans la fonction SumIfs

akni

XLDnaute Nouveau

job75

Lone-wolf

XLDnaute Barbatruc

akni

XLDnaute Nouveau

Pièces jointes

akni

XLDnaute Nouveau

job75

XLDnaute Barbatruc

akni

XLDnaute Nouveau

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

Discussions similaires