consolider avec critère sur le nom de feuille et l'emplacement de cellule

auréliek · 21 Juin 2017

Bonjour,

je ne trouve pas comment rédiger une formule pour une action qui ne doit pas être si compliquée que ça...

Je joins un fichier présentant le fonctionnement du mien.
Il contient des feuilles toutes construites à l'identique.
Je vais avoir plusieurs feuilles de consolidation de données (qui somment les valeurs présentes dans d'autres feuilles), chacune répondant à un critère qui est répertorié dans une feuille 'liste'.
Idéalement je mettrais également un critère pour trouver la cellule à sommer pour me laisser la liberté de modifier les feuilles au besoin. Sinon je protégerai les feuilles pour que leur architecture ne soit pas modifiée.

Dans le fichier exemple, j'ai indiqué dans une cellule (traduit en mots) ce que j'essaie de demander à excel dans la feuille 'Conso':
=somme les valeurs contenues dans la quatrième colonne en face de "ref1" des feuilles répondant au critère A dans la feuille 'Liste'

Quelqu'un peut m'indiquer comment faire?

merci d'avance,

Aurélie

job75 · 21 Juin 2017

Bonjour auréliek, bienvenue sur XLD,

Voyez le fichier joint et cette fonction VBA :

Code:

Function Conso(critere, Liste As Range, P As Range)
Application.Volatile 'recalcul à chaque modification du classeur
Dim col%, ref, i&, w As Worksheet, r As Range, c As Range
col = Application.Caller.Column - P.Column + 1 'n° de colonne par rapport à P
ref = Application.Caller.Cells(1, 2 - col) 'valeur dans P à rechercher
On Error Resume Next 'si une feuille n'existe pas
For i = 1 To Liste.Rows.Count
  If Liste.Cells(i, 2) = critere Then
    Set w = Nothing: Set r = Nothing: Set c = Nothing 'RAZ
    Set w = Worksheets(CStr(Liste.Cells(i, 1)))
    Set r = w.Range(P.Address)
    Set c = r(Application.Match(ref, r.Columns(1), 0), col)
    Conso = Conso + c
  End If
Next
If Conso = 0 Then Conso = ""
End Function

Le code doit impérativement être placé dans un module standard (Module1).

La fonction est utilisée dans toute la plage en jaune.

A+

job75 · 21 Juin 2017

Re,

Une autre solution avec ce fichier (2) :

Code:

Function Conso(critere, Liste As Range, ref As Range)
Application.Volatile 'recalcul à chaque modification du classeur
Dim col%, i&, w As Worksheet, c As Range
col = Application.Caller.Column - ref.Column + 1 'n° de colonne par rapport à ref
On Error Resume Next 'si une feuille n'existe pas
For i = 1 To Liste.Rows.Count
  If Liste.Cells(i, 2) = critere Then
    Set w = Nothing: Set c = Nothing 'RAZ
    Set w = Worksheets(CStr(Liste.Cells(i, 1)))
    Set c = w.Cells.Find(ref, , xlValues, xlWhole)(1, col)
    Conso = Conso + c
  End If
Next
If Conso = 0 Then Conso = ""
End Function

Elle suppose que :

- les références ref1 ref2 ref3 etc... sont uniques dans chaque feuille

- l'ordre des colonnes à partir de ces références est le même dans toutes les feuilles.

Par ailleurs voyez la Workbook_Open qui évite l'invite à la fermeture du fichier.

A+

auréliek · 22 Juin 2017

job75 à dit:
Re,

Une autre solution avec ce fichier (2) :

Code:

Function Conso(critere, Liste As Range, ref As Range) Application.Volatile 'recalcul à chaque modification du classeur Dim col%, i&, w As Worksheet, c As Range col = Application.Caller.Column - ref.Column + 1 'n° de colonne par rapport à ref On Error Resume Next 'si une feuille n'existe pas For i = 1 To Liste.Rows.Count If Liste.Cells(i, 2) = critere Then Set w = Nothing: Set c = Nothing 'RAZ Set w = Worksheets(CStr(Liste.Cells(i, 1))) Set c = w.Cells.Find(ref, , xlValues, xlWhole)(1, col) Conso = Conso + c End If Next If Conso = 0 Then Conso = "" End Function

Elle suppose que :

- les références ref1 ref2 ref3 etc... sont uniques dans chaque feuille

- l'ordre des colonnes à partir de ces références est le même dans toutes les feuilles.

Par ailleurs voyez la Workbook_Open qui évite l'invite à la fermeture du fichier.

A+

Merci beaucoup job75.
Je suis en train de tester ta première solution déjà et ça fonctionne, c'est super.
Par contre comme je ne connais pas le code VBA, je ne suis pas autonome pour faire des modifs en cas de besoin. Et donc je risque de re-solliciter la communauté...

Il va falloir que je fasse un peu évoluer quand même pour les raisons suivantes:

1/il faudrait que je puisse ajouter un second critère dans ma feuille de liste (en colonne C) et donc demander une conso SI critère 1=A ET critère 2=X

2/je manipule le fichier depuis un petit MacBook Air, qui ne supporte absolument pas la lourdeur du recalcul permanent de la macro. Ca me plante Excel à tout bout de champ. Je vais essayer en désactivant l'option de calcul auto, mais la plupart des collaborateurs qui utiliseront ce fichier sont sur Mac également, et n'ont pas forcément une machine très puissante ni de compétences Excel leur permettant d'être à l'aise en cas de pépin... Ils pourraient éventuellement ouvrir le fichier en désactivant les macros mais dans ce cas ne pourront pas consulter les feuilles de consolidation.
(J'avais modifié la formule pour la basculer sur une recherche en colonnes entières mais je vais revenir à une aire plus restreinte aussi.)

3/est-ce que je peux demander un calcul entre 2 cellules contenant le calcul faisant appel à la macro?
ex dans mon fichier: demander E14-D14 me sort #VALEUR
et est-ce que ça allégerait les calculs plutôt que de faire le calcul dans chaque feuille et passer à nouveau par la macro?

Est-ce que ta deuxième proposition va dans le sens d'un process moins lourd ou rien à voir?

merci encore pour ton aide

job75 · 22 Juin 2017

Bonjour auréliek, le forum,

Les solutions que j'ai données répondent à la question et au fichier du post #1.

Maintenant vous voulez faire d'autres choses.

Alors joignez un fichier complet et présentez clairement le nouveau problème.

Si l'utilisation d'une fonction volatile vous gêne on pourra s'en passer.

A+

auréliek · 22 Juin 2017

Ah. Ok. Je recommence alors.
Désolée je débute sur ce genre de forum.

Rebonjour le forum!

Voici un fichier plus complet.
Il contient des feuilles toutes construites à l'identique.
Je vais avoir plusieurs feuilles de consolidation de données (qui somment les valeurs présentes dans d'autres feuilles), identiques aux autres feuilles, chaque sélection à consolider répondant à des critères qui sont répertoriés dans une feuille 'liste'.
Sur mes feuilles de consolidation, je vais calculer des écarts en colonne, écarts qui sont déjà calculés sur les autres feuilles et qu'il faut sommer, ou que je peux calculer directement dans la feuille de conso.

La lourdeur du fichier, de ses process de calculs, est à prendre en compte dans la solution à envisager.
J'aurai en tout environ:
50 feuilles, 4 'critères 1' A B C D, 2 'critères 2' X Y, jusqu'à 300 cellules à consolider dans chaque feuille réparties sur environ 70 lignes 'référence'
et 12 feuilles de consolidation: A, AX, AY, B, BX, BY, etc
Pas de matériel très performant chez les utilisateurs du fichier, plantages faciles d'excel.
Pas de nécessité d'une mise à jour immédiate des résultats de calcul dans les feuilles de conso, à la sauvegarde seulement peut suffire. Par contre, dans les autres feuilles si!
(Egalement d'autres feuilles dans le fichier comportant des liens et des calculs mais non concernées par ma demande ici)

Aie aie aie, j'espère que c'est plus clair comme ça...

Quelqu'un peut m'aider?

merci d'avance,

Aurélie

job75 · 22 Juin 2017

Re,

Il est sûr que si vos notions en VBA sont limitées vous allez avoir du mal à suivre...

Voyez ce fichier et le code dans ThisWorkbook :

Code:

Option Compare Text 'la casse est ignorée (sécurité)

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Not Sh.Name Like "Conso critère*" Then Exit Sub
Dim Pref As Range, Pdest As Range, tref, tdest, ncol%, d As Object, i&
Dim critere$, tablo, w As Worksheet, t1, t2, j&, lig&, k%
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
On Error Resume Next
'---préparation et RAZ---
Set Pref = Sh.[A14:A103] 'à adapter
Set Pdest = Sh.[D14:F103] 'à adapter
Pdest.SpecialCells(xlCellTypeConstants) = "" 'RAZ
tref = Pref 'matrice, plus rapide
tdest = Pdest.Formula 'matrice, plus rapide
ncol = UBound(tdest, 2)
'---liste des références et repérage de leurs lignes---
Set d = CreateObject("Scripting.dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
For i = 1 To UBound(tref)
  If tref(i, 1) <> "" Then d(tref(i, 1)) = i
Next i
'---analyse des feuilles et remplissage du tableau tdest---
critere = Replace(Sh.Name, " et ", Chr(1))
critere = Chr(1) & Trim(Mid(critere, 15)) & Chr(1)
tablo = Sheets("Liste").[A1].CurrentRegion.Resize(, 3)
For i = 2 To UBound(tablo)
  If InStr(Chr(1) & tablo(i, 2) & Chr(1) & tablo(i, 3) & Chr(1), critere) Then
    Set w = Nothing
    Set w = Sheets(CStr(tablo(i, 1)))
    If Not w Is Nothing Then
      t1 = w.Range(Pref.Address) 'matrice, plus rapide
      t2 = w.Range(Pdest.Address) 'matrice, plus rapide
      For j = 1 To UBound(t1)
        If d.exists(t1(j, 1)) Then
          lig = d(t1(j, 1)) 'récupération de la ligne
          For k = 1 To ncol
            If t2(j, k) <> "" Then tdest(lig, k) = Val(Replace(tdest(lig, k), ",", ".")) + Val(Replace(t2(j, k), ",", "."))
          Next k
        End If
      Next j
    End If
  End If
Next i
'---restitution---
Pdest = tdest
Application.EnableEvents = True 'réactive les évènements
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Workbook_SheetActivate Sh
End Sub

Avec des tableaux VBA l'exécution est très rapide.

A+

job75 · 22 Juin 2017

Re,

Ce qui précède suppose qu'on travaille sur une version Excel classique.

Je crois que l'objet Dictionary n'existe pas sur MAC, si vous travaillez sur MAC débrouillez-vous.

Mais le mieux sera de changer d'ordinateur.

A+

job75 · 22 Juin 2017

Re,

Je vous mets quand même une solution simplifiée sans utilisation du Dictionary :

Code:

Option Compare Text 'la casse est ignorée (sécurité)

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Not Sh.Name Like "Conso critère*" Then Exit Sub
Dim Pref As Range, Pdest As Range, tref, tdest, ncol%
Dim critere$, tablo, i&, w As Worksheet, t1, t2, j&, k%
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
On Error Resume Next
'---préparation et RAZ---
Set Pref = Sh.[A14:A103] 'à adapter
Set Pdest = Sh.[D14:F103] 'à adapter
Pdest.SpecialCells(xlCellTypeConstants) = "" 'RAZ
tref = Pref 'matrice, plus rapide
tdest = Pdest.Formula 'matrice, plus rapide
ncol = UBound(tdest, 2)
'---analyse des feuilles et remplissage du tableau tdest---
critere = Replace(Sh.Name, " et ", Chr(1))
critere = Chr(1) & Trim(Mid(critere, 15)) & Chr(1)
tablo = Sheets("Liste").[A1].CurrentRegion.Resize(, 3)
For i = 2 To UBound(tablo)
  If InStr(Chr(1) & tablo(i, 2) & Chr(1) & tablo(i, 3) & Chr(1), critere) Then
    Set w = Nothing
    Set w = Sheets(CStr(tablo(i, 1)))
    If Not w Is Nothing Then
      t1 = w.Range(Pref.Address) 'matrice, plus rapide
      t2 = w.Range(Pdest.Address) 'matrice, plus rapide
      For j = 1 To UBound(t1)
        If tref(j, 1) = t1(j, 1) Then
          For k = 1 To ncol
            If t2(j, k) <> "" Then tdest(j, k) = Val(Replace(tdest(j, k), ",", ".")) + Val(Replace(t2(j, k), ",", "."))
          Next k
        End If
      Next j
    End If
  End If
Next i
'---restitution---
Pdest = tdest
Application.EnableEvents = True 'réactive les évènements
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Workbook_SheetActivate Sh
End Sub

La contrainte est que les mêmes références doivent être sur les mêmes lignes dans toutes les feuilles.

A+

auréliek · 26 Juin 2017

job75 à dit:

Re,

Je vous mets quand même une solution simplifiée sans utilisation du Dictionary :

Code:

Option Compare Text 'la casse est ignorée (sécurité)

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Not Sh.Name Like "Conso critère*" Then Exit Sub
Dim Pref As Range, Pdest As Range, tref, tdest, ncol%
Dim critere$, tablo, i&, w As Worksheet, t1, t2, j&, k%
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
On Error Resume Next
'---préparation et RAZ---
Set Pref = Sh.[A14:A103] 'à adapter
Set Pdest = Sh.[D14:F103] 'à adapter
Pdest.SpecialCells(xlCellTypeConstants) = "" 'RAZ
tref = Pref 'matrice, plus rapide
tdest = Pdest.Formula 'matrice, plus rapide
ncol = UBound(tdest, 2)
'---analyse des feuilles et remplissage du tableau tdest---
critere = Replace(Sh.Name, " et ", Chr(1))
critere = Chr(1) & Trim(Mid(critere, 15)) & Chr(1)
tablo = Sheets("Liste").[A1].CurrentRegion.Resize(, 3)
For i = 2 To UBound(tablo)
  If InStr(Chr(1) & tablo(i, 2) & Chr(1) & tablo(i, 3) & Chr(1), critere) Then
    Set w = Nothing
    Set w = Sheets(CStr(tablo(i, 1)))
    If Not w Is Nothing Then
      t1 = w.Range(Pref.Address) 'matrice, plus rapide
      t2 = w.Range(Pdest.Address) 'matrice, plus rapide
      For j = 1 To UBound(t1)
        If tref(j, 1) = t1(j, 1) Then
          For k = 1 To ncol
            If t2(j, k) <> "" Then tdest(j, k) = Val(Replace(tdest(j, k), ",", ".")) + Val(Replace(t2(j, k), ",", "."))
          Next k
        End If
      Next j
    End If
  End If
Next i
'---restitution---
Pdest = tdest
Application.EnableEvents = True 'réactive les évènements
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Workbook_SheetActivate Sh
End Sub

La contrainte est que les mêmes références doivent être sur les mêmes lignes dans toutes les feuilles.

A+

Bonjour job75, bonjour le forum,

merci beaucoup. Effectivement la première proposition ne fonctionne pas sur Mac mais la seconde oui.

Et de fait, je n'arrive pas à reproduire cette dernière dans mon vrai fichier, ça ne fonctionne pas pour cause de connaissances VBA nulles... j'ai eu beau essayer de déchiffrer tout ce code pendant une heure et d'y apporter les ajustements nécessaires, en vain!
Alors j'ai opté pour une autre solution: je transfère tous mes onglets dans le fichier que tu m'as envoyé et qui fonctionne, et ça a l'air d'aller! J'espère que les contrôles finaux seront ok.

merci infiniment de ton aide.

Une belle journée à tous,

A bientôt

job75 · 26 Juin 2017

Bonjour auréliek,

auréliek à dit:
Et de fait, je n'arrive pas à reproduire cette dernière dans mon vrai fichier, ça ne fonctionne pas pour cause de connaissances VBA nulles..

J'ai indiqué dans la macro ce qu'il faut adapter, il n'y a que 2 lignes.

Ne pas toucher au reste.

Comme indiqué les noms des feuilles à traiter doivent commencer par Conso critère suivi ou non d'un s.

Edit : et n'oubliez pas Option Compare Text tout en haut de la feuille.

A+

consolider avec critère sur le nom de feuille et l'emplacement de cellule

auréliek

XLDnaute Nouveau

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

auréliek

XLDnaute Nouveau

job75

XLDnaute Barbatruc

auréliek

XLDnaute Nouveau

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Pièces jointes

auréliek

XLDnaute Nouveau

job75

XLDnaute Barbatruc

Discussions similaires