XL 2013 VBA Boucle avec Formule Matricielle

spawn78 · 5 Octobre 2020

Bonjour,

Je tente désespérément depuis des jours de construire une macro, mais je n'arrive pas à trouver le bon code pour que cela fonctionne ou la bonne logique.
J'ai une liste de salarié avec une correspondance manager donc deux colonnes. Dans la colonne manager il y a aussi des directeurs, qui dirige des managers qui sont également dans la liste des salariés. Le but de l'exercice est créer une liste de salarié sous chaque directeur, mais également les managers ont des salariés qui eux mêmes se retrouve à manger d'autres salariés, ce qui fait qu'il faut que je trouve un macro ou une formule qui effectue de la récursivité sur une colonne...

J'ai commencé à écrire le code comme ceci :

VB:

Sub frequence()

Dim derligne As Long



Dim I As Integer




derligne = Cells.Find("*", , , , xlByRows, xlPrevious).Row



For I = 2 To 9





Range("B" & derligne + 1).FormulaArray = "=IF(ROWS(BASE!R1:R[-1])<=COUNTIF(Manager,R[-9]C2),INDEX(Salarié,MATCH(R[-9]C2,Manager,0)-1+ROWS(BASE!R1:R[-1])),"""")"
  

Next I



End Sub

Je souhaiterais extraire sur l'onglet "SYNTHESE" dans la colonne B tous les salariés relatif aux managers qu'il aura trouvé dans les premiers résultats.

Je vous remercie pour votre aide.

mapomme · 5 Octobre 2020

Bonsoir @spawn78 ,

Sur l'excellentissime site (on ne le répètera jamais assez) du Maitre Jacques Boisgontier (@BOISGONTIER), il y a tout un chapitre consacré aux arborescences et à la récursivité.
Le lien est ici => http://boisgontierjacques.free.fr/pages_site/Recursivite.htm
C'est une mine d'or. Vous y trouverez sans doute les outils nécessaires.

mapomme · 5 Octobre 2020

Bonsoir @spawn78 ,

Sur l'excellentissime site (on ne le répètera jamais assez) du Maitre Jacques Boisgontier (@BOISGONTIER), il y a tout un chapitre consacré aux arborescences et à la récursivité.
Le lien est ici => http://boisgontierjacques.free.fr/pages_site/Recursivite.htm
C'est une mine d'or. Vous y trouverez sans doute les outils nécessaires.

spawn78 · 6 Octobre 2020

mapomme à dit:
Bonsoir @spawn78 ,

Sur l'excellentissime site (on ne le répètera jamais assez) du Maitre Jacques Boisgontier (@BOISGONTIER), il y a tout un chapitre consacré aux arborescences et à la récursivité.
Le lien est ici => http://boisgontierjacques.free.fr/pages_site/Recursivite.htm
C'est une mine d'or. Vous y trouverez sans doute les outils nécessaires.

Bonjour Mapomme, effectivement ce site est une pépite, que je connais depuis pas mal de temps, effectivement en persévérant j'ai trouvé une solution.

Merci

Dranreb · 6 Octobre 2020

Bonjour.
C'est quelque chose comme ça :

VB:

Option Explicit
Private TDon(), TRés(), LR As Long
Sub Frequence()
   TDon = Feuil3.UsedRange
   ReDim TRés(1 To UBound(TDon, 1), 1 To 7): LR = 0
   Empiler Feuil4.[A2].Value, 1
   Feuil4.[B2].Resize(UBound(TRés, 1), UBound(TRés, 2)).Value = TRés
   Erase TDon, TRés
   End Sub
Private Sub Empiler(ByVal NomSal As String, C As Long)
   Dim L As Long
   On Error Resume Next
   L = WorksheetFunction.Match(NomSal, WorksheetFunction.Index(TDon, 0, 1), 0)
   On Error GoTo 0
   If L = 0 Then Exit Sub
   Do
      LR = LR + 1: TRés(LR, C) = TDon(L, 2)
      If C < 7 Then Empiler TDon(L, 2), C + 1
      L = L + 1: If L > UBound(TDon, 1) Then Exit Do
      Loop Until TDon(L, 1) <> NomSal
   End Sub

Pas gentil la blague de BIENVENU qui commande OUSFOURI, qui commande BIENVENU !

spawn78 · 6 Octobre 2020

Dranreb à dit:

Bonjour.
C'est quelque chose comme ça :

VB:

Option Explicit
Private TDon(), TRés(), LR As Long
Sub Frequence()
   TDon = Feuil3.UsedRange
   ReDim TRés(1 To UBound(TDon, 1), 1 To 7): LR = 0
   Empiler Feuil4.[A2].Value, 1
   Feuil4.[B2].Resize(UBound(TRés, 1), UBound(TRés, 2)).Value = TRés
   Erase TDon, TRés
   End Sub
Private Sub Empiler(ByVal NomSal As String, C As Long)
   Dim L As Long
   On Error Resume Next
   L = WorksheetFunction.Match(NomSal, WorksheetFunction.Index(TDon, 0, 1), 0)
   On Error GoTo 0
   If L = 0 Then Exit Sub
   Do
      LR = LR + 1: TRés(LR, C) = TDon(L, 2)
      If C < 7 Then Empiler TDon(L, 2), C + 1
      L = L + 1: If L > UBound(TDon, 1) Then Exit Do
      Loop Until TDon(L, 1) <> NomSal
   End Sub

Pas gentil la blague de BIENVENU qui commande OUSFOURI, qui commande BIENVENU !

Merci Dranreb pour ta solution, je la garde de côté

XL 2013 VBA Boucle avec Formule Matricielle

spawn78

XLDnaute Nouveau

mapomme

mapomme

XLDnaute Barbatruc

spawn78

XLDnaute Nouveau

Dranreb

XLDnaute Barbatruc

spawn78

XLDnaute Nouveau

Discussions similaires