Microsoft 365 Traitement récapitulatif conditionné par valeur d'un tableau

[Carnould]

Bonjour à tous,
Je n'arrive pas à m'en sortir avec un classeur un peu complexe que je ne peux transmettre. J'ai fait un classeur de démo pour simuler le problème que je rencontre.
Si j'obtiens une solution, je la transposerai dans mon classeur en exploitation.
Il s'agit de conditionner une action par la présence d'une certaine valeur dans une table.
Je voudrais que la recherche de la condition soit faite dans une procédure généralisée à laquelle les autres procédures lui passeraient des paramètres en arguments.
Plutôt qu'une explication dans ce texte, j'ai déjà structuré le classeur de démo en conséquence et ai mis mes besoins en commentaires dans une structure VBA (Module1)
Je me répète en disant qu'il s'agit bien là d'un classeur de démo mais dont le fonctionnement est représentatif de ce que je recherche.
Merci à vous tous par avance
Christian

 

[Hasco]

Bonjour,

Bien, bien le cahier des charges.
Mais où doit-on adresser la facture ?

Pas même une tentative d'un début de commencement de codage. Pourtant vous avez des notions semble-t-il ? Pour ma part, je passe mon chemin... Je ne suis pas aux ordres.

 

[Staple1600]

Bonjour le fil

•>Roblochon
Je vous interdis de passer votre chemin!
Z'êtes confiné, palsambleu!
Et pas la peine vous cacher en haut du phare de K. Germ***e.
(gBoN?)

•>Carnould

mes besoins en commentaires dans une structure VBA (Module1)

Pour mes besoins, moi, je veux que tu postes le Module1 dans la discussion.
(Ça me permet de savoir si je vais télécharger ou pas le classeur en fonction de ce que je lirai dans le dit Module)

 

[Carnould]

Bonjour,

Bien, bien le cahier des charges.
Mais où doit-on adresser la facture ?

Pas même une tentative d'un début de commencement de codage. Pourtant vous avez des notions semble-t-il ? Pour ma part, je passe mon chemin... Je ne suis pas aux ordres.

Bonjour Roblochon,
Je suis désolé de l'importance de ma demande. Mes notions ? Oui je viens de lire "Programmation VBA pour les nuls" et ce dernier qualificatif me correspond pas mal. Alors j'essaie de structurer (un premier pas) de coder (rien n'a focntionné dans mon classeur d'exploitation).
Tant pis pour moi.
Merci tout de même de ton attention.
Je vais encore essayer de creuser et peut-être reviendrai vers toi.
Christian

 

[Carnould]

Bonjour le fil

•>Roblochon
Je vous interdis de passer votre chemin!
Z'êtes confiné, palsambleu!
Et pas la peine vous cacher en haut du phare de K. Germ***e.
(gBoN?)

•>Carnould

Pour mes besoins, moi, je veux que tu postes le Module1 dans la discussion.
(Ça me permet de savoir si je vais télécharger ou pas le classeur en fonction de ce que je lirai dans le dit Module)

Bonsoir Stapple1600
Voici le module 1 in extenso. Je reconnais qu'il n'y a rien comme le décrit Roblochon. Il n'apporte que la compréhension de ce que j'aimerais avoir. Comme le dit ROBLOCHON pour lequel je comprends parfaitement sa réaction bien légitime, je n'ai même pas le début du codage. Je vais essayer de reprendre et transposer ce que j'ai fait mais qui ne fonctionne pas dans mon classeur d'exploitation.

Voici donc le module 1 : si j'avais seulement la procédure Eligibilité() en fonction avec la manière de l'appeler et la manière de récupérer son retour (procédure AlimRécap1, je ferais un grand pas. Je n'en demande pas plus pour l'instant.
Merci
Christian


Sub Eligibilité()
' Doit être une fonction standard utilisable dans différentes procédures
'
' Eligibilité() est appelée par d'autres procédures qui passent
' comme arguments le nom d'une feuille et la catégorie demandée
' (exemple "Feuil1" "Cat1")
' En retour, Eligibilité() transmet la valeur trouvée
' à l'intersection de ces 2 arguments dans la feuille "Catégories"
' (dans l'exemple : O )


End Sub
Sub AlimRécap1()
' C'est un cas d'école
' Cette macro si elle est activée doit remplir le tableau de la
' feuille "Récap1" en prenant la dernière ligne de chaque feuille
' du classeur ELIGIBLE A LA Récap1
' Cette éligibilité est déterminée par la procédure Eligibilité ()
' si le retour d'argument est "O"
'
'
' Cette alimentation est simulée (cf. Feuille "Récap1")


End Sub


Sub alimRécap2()
' Même principe que pour AlimRécap1() mais cette fois en faisant une
' somme de chaque dernière ligne des feuilles éligibles à la Récap2


End Sub
Sub alimRécap3()
' Même principe que pour AlimRécap1() mais cette fois en faisant une
' moyenne des sommes de la dernière ligne des feuilles éligibles à la Récap3
'

End Sub

 

[Hasco]

Hi l'agrafe

phare de K. Germ***e

Tout faux c'est le phare de Pontu...l ou Bri......-P...e [tu trouveras les lettres manquantes dans n'importe quel journal]

bon découpage

 

[Staple1600]

Re

Un petite macro pour commencer
(éligible au titre de bricolage du samedi)

Sub testE()
MsgBox Eligibilite("Feuil1", "Cat1")
MsgBox Eligibilite("Feuil5", "Cat null")
MsgBox Eligibilite("Feuil5", "Cat3")
End Sub
Function Eligibilite(NomF$, vCat$) As Boolean
Dim Rng As Range, Tableau As Range
With Sheets("Catégories")
Set Rng = .[B2:F2]: Set Tableau = .[B3:F9]
End With
X = Application.VLookup(NomF, Tableau, Application.Match(vCat, Rng, 0), 0)
Eligibilite = CStr(X) = "O"
End Function

NB: J'ai converti le tableau Catégories en plage ordinaire (pour me simplifier le test)

 

[Carnould]

Merci Stapp je vais essayer d'avancer avec ça demain.
Je n'arrive pas à comprendre les 2 dernières lignes
x = Application.....
Éligibilité =....

(Dans mes précédents essais je butais justement sur la façon d'adresser un tableau nommé)

 

[Staple1600]

Re

•>Carnould
Tu butes également sur la façon d'écrire mon pseudo...

Sinon pour les deux lignes qui te posent question.
Positionnes-toi sur la feuille Catégories avant de lancer la macro
ci-dessous

Sub Fiat_Lux()
With Sheets("Catégories")
.[H2:I2].Value = [{"Feuil5","Cat3"}]
.[H2:I2,H3].Borders.Weight = 2
With .[H3]
.FormulaR1C1 = "=VLOOKUP(R[-1]C,R3C2:R9C6,MATCH(R[-1]C[1],R2C2:R2C6,0),0)"
.Font.Bold = True: .Font.Color = vbYellow: .Interior.Color = vbBlack
.Select
End With
End With
End Sub

C'est plus clair?
Tu vois ce que cela explique?

 

[Staple1600]

Bonjour le fil

•>Carnould
Finalement, les tableaux (ListObject), c'est chouette
Test OK sur ton fichier Exemple

Sub AlimRécap1()
Dim LO As ListObject, LO_A As ListObject, DlG&, ws As Worksheet
Set LO_A = Sheets("Récap1").ListObjects(1)
For Each ws In Worksheets
    If ws.Name Like "Feuil*" Then
      If Eligibilité(ws.Name, "Cat1") Then
        Set LO = ws.ListObjects(1)
        DlG = LO.DataBodyRange.Rows.Count + 1
        LO_A.ListRows.Add.Range = LO.Range.Rows(DlG).Value
      End If
    Set LO = Nothing
    End If
Next
End Sub
Private Function Eligibilité(NomF$, vCat$) As Boolean
Dim vArr, LO As ListObject, R&, C&
Set LO = Sheets("Catégories").ListObjects("TableauCatégories")
vArr = LO.DataBodyRange
With Application
C = .Match(vCat, LO.HeaderRowRange, 0): R = .Match(NomF, LO.DataBodyRange.Columns(1), 0)
Eligibilité = CStr(.Index(vArr, R, C)) = "O"
End With
End Function

Je te laisse mettre le mains dans le cambouis pour à partir de AlimRécap1 créer les autres macros.

 

[Carnould]

Merci Staple1600. Désolé d'avoir déformé ton pseudo. Pour les deux "P" , je fais la même faute en français : je mets deux ff à agrafe.
Plaisanterie mise à part, je vais regarder cela de près et surtout essayer de comprendre. C'est indispensable pour moi de passer par cette phase. Copier du tout fait sans comprendre ne m'enrichirait pas. Un gros travail en perspective de ma part.
Bien cordialement
Christian

 

[Carnould]

Bonjour le fil

•>Carnould
Finalement, les tableaux (ListObject), c'est chouette
Test OK sur ton fichier Exemple

Sub AlimRécap1()
Dim LO As ListObject, LO_A As ListObject, DlG&, ws As Worksheet
Set LO_A = Sheets("Récap1").ListObjects(1)
For Each ws In Worksheets
    If ws.Name Like "Feuil*" Then
      If Eligibilité(ws.Name, "Cat1") Then
        Set LO = ws.ListObjects(1)
        DlG = LO.DataBodyRange.Rows.Count + 1
        LO_A.ListRows.Add.Range = LO.Range.Rows(DlG).Value
      End If
    Set LO = Nothing
    End If
Next
End Sub
Private Function Eligibilité(NomF$, vCat$) As Boolean
Dim vArr, LO As ListObject, R&, C&
Set LO = Sheets("Catégories").ListObjects("TableauCatégories")
vArr = LO.DataBodyRange
With Application
C = .Match(vCat, LO.HeaderRowRange, 0): R = .Match(NomF, LO.DataBodyRange.Columns(1), 0)
Eligibilité = CStr(.Index(vArr, R, C)) = "O"
End With
End Function

Je te laisse mettre le mains dans le cambouis pour à partir de AlimRécap1 créer les autres macros.

Très formateur. Je commence à mieux comprendre. Le chemin est encore long. Pas facile d'imaginer ce code sans un peu d'expérience. Il faut tatonner, essayer, se planter, recommencer. C'est un langage très verbeux avec lequel on passe beaucoup de temps au début mais j'imagine efficace ensuite. Et comment retenir toutes les possibilités quand je vois toutes les "propiétés" et "méthodes" des "objets". On peut écrire de manières radicalement différentes un programme. C'est là toute la difficulté quand on débute et qu'on s'appuie sur des exemples trouvés ci ou là et qui aborde le problème sous des angles complétements différents.
Merci pour ton aide très sympathique et précise, Staple1600.
Très cordialement
Christian

 

[Staple1600]

Le chemin est encore long. Pas facile d'imaginer ce code sans un peu d'expérience. Il faut tatonner, essayer, se planter, recommencer.

Comme disait Maitre Yoda
"L'échec, le meilleur des maîtres, être"
Te voila donc ,devenu un apprenti du VBA désormais.
"Que l'Option soit Explicit et avec toi, jeune padawan"*

*: Ni Yoda, ni Luc, Obi-Wan n'ont prononcé cette phrase

 

[Carnould]

Comme disait Maitre Yoda
"L'échec, le meilleur des maîtres, être"
Te voila donc ,devenu un apprenti du VBA désormais.
"Que l'Option soit Explicit et avec toi, jeune padawan"*

*: Ni Yoda, ni Luc, Obi-Wan n'ont prononcé cette phrase

"Fiat Lux" mais de nombreuses zones d'ombres encore pour le "jeune" (ça me fait plaisir vu mon grand âge) Padawan.

 

[Carnould]

Bonjour le fil

•>Carnould
Finalement, les tableaux (ListObject), c'est chouette
Test OK sur ton fichier Exemple

Sub AlimRécap1()
Dim LO As ListObject, LO_A As ListObject, DlG&, ws As Worksheet
Set LO_A = Sheets("Récap1").ListObjects(1)
For Each ws In Worksheets
    If ws.Name Like "Feuil*" Then
      If Eligibilité(ws.Name, "Cat1") Then
        Set LO = ws.ListObjects(1)
        DlG = LO.DataBodyRange.Rows.Count + 1
        LO_A.ListRows.Add.Range = LO.Range.Rows(DlG).Value
      End If
    Set LO = Nothing
    End If
Next
End Sub
Private Function Eligibilité(NomF$, vCat$) As Boolean
Dim vArr, LO As ListObject, R&, C&
Set LO = Sheets("Catégories").ListObjects("TableauCatégories")
vArr = LO.DataBodyRange
With Application
C = .Match(vCat, LO.HeaderRowRange, 0): R = .Match(NomF, LO.DataBodyRange.Columns(1), 0)
Eligibilité = CStr(.Index(vArr, R, C)) = "O"
End With
End Function

Je te laisse mettre le mains dans le cambouis pour à partir de AlimRécap1 créer les autres macros.

Bonsoir Staple1600,
Dans la vie réelle, j'ai des feuilles qui,
-d'une part ne sont pas libellées "Feuil*" mais portent des noms de personnes (pour ça je saurai en principe gérer l'appel de la fonction "Eligibilité")
-d'autre part ne sont pas répertoriées dans le tableau équivalent à "Catégorie". Ces feuilles nécessitent d'être considérées comme n'ayant pas reçu le "O" retourné par la fonction "Eligibilité".

Pour ce dernier cas, j'ai modifié la fonction "Eligibilité" pour ajouter une première recherche (Find) avant les fonctions .match et ajouté une condition pour ne pas dérouler les fonctions .match qui planteraient si la feuille n'est pas présente dans le tableau.
La fonction Find semble bien se dérouler mais le test "If" qui suit ne s'exécute pas (j'ai essayé différentes façons de tests)
Est-ce un problème de type de variable ?
Padawan loin de livrer seul ses battles !
Merci d'avance si tu vois une raison.
Cordialement
Christian
'-----------------------------------------------------------------------------------------
Private Function Eligibilité(NomF$, vCat$) As Boolean
Dim vArr, LO As ListObject, R&, C&
Dim Trouve As Variant 'Ligne ajoutée

Set LO = Sheets("Catégories").ListObjects("TableauCatégories")
vArr = LO.DataBodyRange
With Application
Trouve = .Find(NomF, LO.DataBodyRange.Columns(1)) 'Ligne ajoutée
If Trouve <> "" Then 'Ligne ajoutée
R = .Match(NomF, LO.DataBodyRange.Columns(1), 0)
C = .Match(vCat, LO.HeaderRowRange, 0)
Eligibilité = CStr(.Index(vArr, R, C)) = "O"
Else: Eligibilité = False 'Ligne ajoutée
End If 'Ligne ajoutée
End With
End Function
'-----------------------------------------------------------------
Sub AlimRécap1()
Dim LO As ListObject, LO_A As ListObject, DlG&, ws As Worksheet
Set LO_A = Sheets("Récap1").ListObjects(1)
For Each ws In Worksheets
If ws.Name Like "Feuil*" Then
If Eligibilité(ws.Name, "Cat1") Then
Set LO = ws.ListObjects(1)
DlG = LO.DataBodyRange.Rows.Count + 1
LO_A.ListRows.Add.Range = LO.Range.Rows(DlG).Value
End If
Set LO = Nothing
End If
Next

End Sub