XL pour MAC Somme issue d'une recherche sur plusieurs feuilles

fpinet

XLDnaute Nouveau
Bonjour,
Grand débutant, j'ai besoin d'aide pour une formule, je vais essayer d'être précis. Je cherche à réaliser la somme de données récupéré sur plusieurs onglets (plus de 10 au final) d'un classeur. J'ai tenté d'utiliser la fonction sommeprod et rechercheV mais je coince.
Le plus est que regardiez le fichier exemple que je viens de préparer.

Merci pour votre aide
 

Pièces jointes

  • TEST.xlsx
    27.5 KB · Affichages: 22

Jocelyn

XLDnaute Barbatruc
Bonjour le Forum,
Bonjour fpinet,

un essai en fichier joint

cordialement

EDIT : Correction j'avais juste créé un décalage dans

VB:
=SOMMEPROD(SOMME.SI(INDIRECT("'"&plage&"'!A2:A100");B4;INDIRECT("'"&plage&"'!B2:B100")))

j'avais fait référence à

=SOMMEPROD(SOMME.SI(INDIRECT("'"&plage&"'!A2:A100");B2;INDIRECT("'"&plage&"'!B2:B100")))

merci de m'avoir averti Job75
 

Pièces jointes

  • TEST (2).xlsm
    12.3 KB · Affichages: 6
Dernière édition:

job75

XLDnaute Barbatruc
Bonjour fpinet, bienvenue sur XLD, salut Jocelyn,

Jocelyn d'évidence tes résultats sont faux.

Puisqu'il faut un fichier .xlsm autant utiliser une fonction VBA :
VB:
Function SommeFeuilles(cible$, col%)
Application.Volatile
Dim w As Worksheet, tablo, i&
For Each w In Worksheets
    If w.Name <> Application.Caller.Parent.Name Then
        tablo = w.UsedRange.Resize(, col + 1) 'matrice, plus rapide
        For i = 1 To UBound(tablo)
            If tablo(i, col) = cible Then _
                If IsNumeric(tablo(i, col + 1)) Then SommeFeuilles = SommeFeuilles + tablo(i, col + 1)
        Next
    End If
Next
End Function
Le code doit être placé impérativement dans un module standard.

Formule en C4 de la feuille "DONNEES", à tirer vers le bas :
Code:
=SommeFeuilles(B4;1)
Le 2ème argument indique le numéro de colonne de la recherche dans les feuilles.

La fonction est volatile : elle se recalcule quand on modifie des données dans une feuille quelconque.

Bonne journée.
 

Pièces jointes

  • TEST VBA(1).xlsm
    25.7 KB · Affichages: 20

zebanx

XLDnaute Accro
Bonjour Fpinet, Jocelyn ;) , Job75;)

@job75
Bravo pour ce code concis et très efficace.
Très bel UDF et qui répond à des besoins récurrents.

Deux suggestions :
1. A voir si on préfère travailler sur le nom ou par index
2. On rend le choix de la colonne de résultat "dynamique".

Ca donnerait un UDF SF dans le fichier joint avec le code suivant

VB:
Function SF(cible$, col%, z%)
'-- code principal de job75
'-- Somme Feuilles
'-- cible = référence, col = colonne où est la référence, z = colonne de recherche
Application.Volatile                                 '--E1
Dim w As Worksheet, tablo, i&
For Each w In Worksheets
    'If w.Name <> Application.Caller.Parent.Name Then                 '--E2
        If w.Index > Application.Caller.Parent.Index Then                 '--E3
        tablo = w.UsedRange.Resize(, col + z) 'matrice, plus rapide
        For i = 1 To UBound(tablo)
            If CStr(tablo(i, col)) = cible Then _
                If IsNumeric(tablo(i, z)) Then SF = SF + tablo(i, z)
        Next
    End If
Next
'-- E1 : La fonction est volatile : elle se recalcule quand
' on modifie des données dans une feuille quelconque.
'-- E2 : si on veut toutes les feuilles
'-- E3 : si on veut les feuilles suivantes
End Function
 

Pièces jointes

  • Somme Feuille et SF.xlsm
    21.1 KB · Affichages: 15

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Bonjour,

Il suffit de

=SOMMEPROD(SOMME.SI(INDIRECT("'"&nf&"'!A2:A100");B3;INDIRECT("'"&nf&"'!B2:B100")))



Le nom des feuilles peut être obtenu automatiquement avec

=STXT(LIRE.CLASSEUR(1);TROUVE("]";LIRE.CLASSEUR(1))+1;99)&INDIRECT("iv65000")


Boisgontier
 

Pièces jointes

  • Copie de test.xlsx
    13.2 KB · Affichages: 10
Dernière édition:

fpinet

XLDnaute Nouveau
Bonjour,
J'ai compris, par le VBA on crée une fonction (un programme) que l'on appel sur la cellule. Très efficace donc un grand merci, j'ai retenu la solution de Job75 qui me permet de répondre à ma problématique et plus simple pour le novice que je suis.
Pour ce qui est de la programmation VBA, il faudra que je creuse encore ……
Je clôture donc la demande et encore merci
 

job75

XLDnaute Barbatruc
Re, salut zebanx, JB,

La solution que j'ai donnée fonctionne bien sur MAC mais ce n'est pas une bonne solution s'il y a beaucoup de noms à traiter.

En effet testez avec seulement 1000 noms dans chaque feuille : chez moi le recalcul des formules se fait en 5 secondes.

C'est beaucoup trop long car le recalculi se produit chaque fois qu'on modifie une cellule quelconque, la fonction VBA étant volatile.

La bonne solution VBA, mais qui ne fonctionne pas sur MAC, c'est cette macro dans le code de la feuille DONNEES, voyez ce fichier (2) :
VB:
Private Sub Worksheet_Activate()
Dim dest As Range, col%, d As Object, w As Worksheet, tablo, i&, a, b, c()
Set dest = [B3] 'cellule de destination, à adapter
col = 1 'numéro de colonne à étudier dans les feuilles
Set d = CreateObject("Scripting.Dictionary") 'n'existe pas sur MAC
For Each w In Worksheets
    If w.Name <> Me.Name Then
        tablo = w.UsedRange.Resize(, col + 1) 'matrice, plus rapide
        For i = 1 To UBound(tablo)
            If IsNumeric(tablo(i, col + 1)) Then d(tablo(i, col)) = d(tablo(i, col)) + tablo(i, col + 1)
        Next
    End If
Next
If d.Count Then
    '---transposition---
    a = d.keys: b = d.items
    ReDim c(UBound(a), 1) 'base 0
    For i = 0 To UBound(a)
        c(i, 0) = a(i): c(i, 1) = b(i)
    Next
    '---restitution---
    Application.ScreenUpdating = False
    If FilterMode Then ShowAllData 'si la feuille est filtrée
    dest.Resize(i, 2) = c
    dest.Resize(i, 2).Sort dest, xlAscending, Header:=xlNo 'tri sur les noms
End If
dest.Offset(d.Count).Resize(Rows.Count - d.Count - dest.Row + 1, 2).ClearContents 'RAZ en dessous
dest.EntireColumn.Resize(, 2).AutoFit 'ajustement largeurs
With UsedRange: End With 'actualise la barre de défilement verticale
End Sub
La macro se déclenche quand on active la feuille, avec 1000 noms l'exécution est immédiate.

A+
 

Pièces jointes

  • TEST VBA(2).xlsm
    75.2 KB · Affichages: 12

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Bonjour,

Fonction perso matricielle réutilisable (0,03 sec pour 6 tableaux de 1000 lignes)


VB:
Function Somme3D(ChampCodes, champNum)
  Application.Volatile
  nLignes = Application.Caller.Rows.Count
  Set d = CreateObject("scripting.dictionary")
  n = Range(ChampCodes).Count
  ReDim TblS(1 To n, 1 To 2)
  fs = Application.Caller.Parent.Name
  For Each s In ActiveWorkbook.Sheets
    If s.Name <> fs Then
      TblC = s.Range(ChampCodes)
      TblN = s.Range(champNum)
      For i = LBound(TblC) To UBound(TblC)
       If TblC(i, 1) <> "" Then
          If d.exists(TblC(i, 1)) Then
           lig = d(TblC(i, 1))                    ' Récupération index TblS()
          Else
           If d.Count > nLignes Then Somme3D = "Pas assez de lignes!": Exit Function
           d(TblC(i, 1)) = d.Count + 1: lig = d.Count: TblS(lig, 1) = TblC(i, 1)
          End If
          TblS(lig, 2) = TblS(lig, 2) + TblN(i, 1) ' Totalisation numérique
        End If
       Next i
    End If
  Next s
  Somme3D = TblS
End Function

Boisgontier
 

Pièces jointes

  • Copie de test.xlsm
    23 KB · Affichages: 11
Dernière édition:

zebanx

XLDnaute Accro
Bonjour à tous,

Les remarques de JOB75 étaient très justes sur une longue plage. #8 et c'est très satisfaisant d'obtenir 2 réponses détaillées qui ont été fournies au #8 par job75 et au #9 par JB.
C'est vraiment agréable de voir l'exercice poussé ainsi :cool:

@job75
1. Pas eu cette impression de lenteur sur mon pc (i5-2500, 8go) et pour un simple test par rapport aux 5 secondes évoquées, serait-il possible STP de tester avec un screenupdating = false et de nous indiquer STP s'il y a une amélioration pour la fonction sommefeuille ?
2. Pour info : je me suis bien cassé les dents sur ton code en essayant de pousser comme au #4 avec la prise en compte de plusieurs colonnes (ie : même approche que réponse à JB ci-dessous : plusieurs colonnes (mais version avec une ligne à remplacer pour swithcher .name avec .index = ok).
Impossible :confused: ...(mais quel code)!

@jb
Très bonne proposition également.
Les tableaux étant rarement à 2 colonnes, ci-joint deux propositions de compléments qui se basent sur le postulat du #4 (ie : plusieurs colonnes, choix démarrage par INDEX plutôt que par NAME).
Les résultats sont satisfaisants mais ayant repris une réponse ancienne donnée avec un indirect que je voulais tester, il s'est affiché des valeurs d'erreurs lors du test dans certaines conditions présentées dans la feuille total (ie : problème avec la feuille S2).
Auriez-vous svp un moment dans la semaine pour m'indiquer d'où vient le problème ? Je vous en remercie par avance.

Le fil évoqué et répondu par vos soins sur des formules matricielles 3d

Merci en tout cas vraiment pour ce double travail à tous les deux. Bon dimanche

zebanx
 

Pièces jointes

  • test_s3d_pas assez ligne.xlsm
    46.1 KB · Affichages: 6
  • test_jb_somme3d 2.xlsm
    29.3 KB · Affichages: 7
Dernière édition:

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Dernière édition:

job75

XLDnaute Barbatruc
Bonjour à tous,

Puisque le Dictionary ne fonctionne pas sur MAC voici dans ce fichier (3) une solution avec 2 collections :
VB:
Private Sub Worksheet_Activate()
Dim dest As Range, col1%, col2%, resu(), w As Worksheet, tablo, i&, cle$, Collec As New Collection, CollecN As New Collection, n&, lig&
Set dest = [B3] 'cellule de destination, à adapter
col1 = 1 'numéro de colonne des noms
col2 = 2 'numéro de colonne des valeurs
ReDim resu(1 To Rows.Count, 1 To 2)
For Each w In Worksheets
    If w.Name <> Me.Name Then
        tablo = w.UsedRange.Resize(, IIf(col1 < col2, col2, col1)) 'matrice, plus rapide
        For i = 1 To UBound(tablo)
            If IsNumeric(CStr(tablo(i, col2))) Then
                On Error Resume Next
                cle = tablo(i, col1)
                Collec.Add cle, cle
                If Err = 0 Then
                    n = n + 1
                    CollecN.Add n, cle 'mémorise la ligne
                    resu(n, 1) = cle
                    resu(n, 2) = tablo(i, col2)
                Else
                    lig = CollecN(cle)
                    resu(lig, 2) = resu(lig, 2) + tablo(i, col2)
                End If
            End If
        Next
    End If
Next
On Error GoTo 0
'---restitution---
If n Then
    Application.ScreenUpdating = False
    If FilterMode Then ShowAllData 'si la feuille est filtrée
    dest.Resize(n, 2) = resu
    dest.Resize(n, 2).Sort dest, xlAscending, Header:=xlNo 'tri sur les noms
End If
dest.Offset(n).Resize(Rows.Count - n - dest.Row + 1, 2).ClearContents 'RAZ en dessous
dest.EntireColumn.Resize(, 2).AutoFit 'ajustement largeurs
With UsedRange: End With 'actualise la barre de défilement verticale
End Sub
J'ai testé avec 100 000 noms dans chaque feuille, la macro s'exécute chez moi en 7,8 secondes contre 6,2 secondes avec le Dictionary.

A+
 

Pièces jointes

  • TEST VBA(3).xlsm
    76.4 KB · Affichages: 6

zebanx

XLDnaute Accro
Merci @job75, @BOISGONTIER

Pour vos dernières réponses.

@job75
Le code du #13 me parait bien plus accessible que le #8, tant mieux d'avoir eu cette proposition là :cool:

@BOISGONTIER
Merci également pour le temps passé à pouvoir compiler et retraité tout cela.
Une question cependant SVP :
Pourquoi utilise-t-on un dLig.RemoveAll ou un dCol.Remove all sur le code de la fonction SD3D triée ?

Ne me reste plus qu'à vous remerciez pour tous ces efforts fournis et vous souhaiter... un bon match !
 

Discussions similaires

Statistiques des forums

Discussions
312 198
Messages
2 086 133
Membres
103 128
dernier inscrit
pmordel@parisbrestconsult