Erreur dans la fonction SumIfs

[akni]

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")))

 

[Lone-wolf]

Bonjour akni

Peut-être comme ceci

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]

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]

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]

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 :

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]

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

Encore une fois un grand Merci.

 

[job75]

Re,

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

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]

Bonjour akni, le forum,

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

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]

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 :

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+