Dans une boucle, déterminer une variable tableau et ventiler ses éléments

[cibleo]

Bonjour à tous 🙂

Dans la macro boucler_ventiler, 12 itérations seront effectuées pour remplir la colonne E.
A chaque itération, une variable tableau différente devra ressortir comme sur le modèle de la macro Les_Manquants1(). Ici, c'est la variable qui devra être générée lors de la 1ère itération.

Pour bien comprendre le cheminement de la macro boucler_ventiler, j'ai donc introduit une variable array "bidon"
En Feuil2, les explications ont l'air indigestes, mais c'est relativement simple à comprendre.

Sub boucler_ventiler()
Dim Plage As Range, DerCel As Range, c As Range
Dim tablo, tablo1, i As Byte, j As Byte, lig As String
With Feuil2
  Set Plage = .Range("A6:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
  Set DerCel = .Range("A" & .Rows.Count).End(xlUp)
End With
tablo = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12)
'Je boucle sur la colonne A à partir de A6
For i = 0 To UBound(tablo)
    Set c = Plage.find(tablo(i), DerCel, xlValues, xlWhole)
    If Not c Is Nothing Then
        firstAddress = c.Address
        j = 0
        'Ici je dois déterminer ma variable tableau
        'pour l'exemple, j'ai figé un array avec 2 éléments "bidon"
        tablo1 = Array("S", "P")
        '''lig = c.Row & ":" & c.Row
        Do
        'ici j'affecte les différents éléments en colonne E
            c.Offset(0, 4) = tablo1(j)
            j = j + 1
            Set c = Plage.FindNext(c)
            '''lig = lig & "," & c.Row & ":" & c.Row
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
    '''ActiveSheet.Range(lig).Select
Next i
End Sub

Sub Les_Manquants1()
'cette macro détermine une variable tablo contenant des éléments manquants
'c'est pour l'exemple, j'aimerais l'intégrer dans la
'macro "boucler_ventiler" pour déterminer une variable tableau
Dim rng As Range, i As Long, k As Byte, tbl1 As Variant, tablo()
Set rng = Range("C6", Cells(6, Columns.Count).End(xlToLeft))
tbl1 = Range("C2:F2"): i = 1
  'je boucle sur la plage ("C2:F2")
  For k = LBound(tbl1, 2) To UBound(tbl1, 2)
    'si la cellule n'existe pas en plage rng (C6:D6)
    If (Application.WorksheetFunction.CountIf(rng, tbl1(1, k)) = 0) Then
      'alors j'écris la cellule dans la variable tablo
      ReDim Preserve tablo(1 To i)
      tablo(i) = tbl1(1, k)
      i = i + 1
    End If
  Next k
  'Transpose tablo à partir de G5
  Range("G5").Resize(1, UBound(tablo)) = tablo
End Sub

Pouvez-vous me venir en aide ? Cibleo

 

[cibleo]

Re : Dans une boucle, déterminer une variable tableau et ventiler ses éléments

Bonjour le forum,

Je reprends,
En colonne A, à partir de la ligne 6, une plage de 24 cellules est constituée de ≠ index (macro indexer())
Au regard de cette colonne, je cherche à compléter une grande matrice de 4 colonnes sur 24 lignes.
4 colonnes parce qu'il y a 4 éléments, 24 lignes parce que factorielle de 4 = 24
En haut, une petite matrice de dimension 4 (4 lignes, 4 colonnes) dont les éléments restent figés.
Dans la grande matrice, les colonnes C et D sont déjà remplies manuellement.
Je souhaite maintenant compléter la colonne E via la macro boucler_ventiler().
Pour y parvenir, je vais rechercher les ≠ index figurant en colonne A

tablo = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12)

- Explications de cette macro à travers la 1ère itération soit le 1er index trouvé :
* je trouve l'index "1" en A6
* dans la grande matrice au regard de A6, je recupère la plage pleine C6😀6 et la cellule la + à droite soit D6
* dans la 1ère colonne de la petite matrice, je recherche la valeur de D6 que je localise en C2
* j'accède alors à C2:F2
* je m'appuie sur les plages C2:F2 et C6😀6 pour faire ressortir les éléménts manquants qui constitueront la variable tableau (macro Les_Manquants1())
* pour finir, je ventile en colonnne E les éléments de cette variable au regard des ≠ index "1" trouvés en colonne A

Pour bien comprendre le déroulement, voir l'illustration en Feuil2 et le cheminement des flèches vertes.

Edit : C et D sont remplies manuellement, cela signifie que :
C a été remplie de cette manière, la suite de 4 éléments (1,2,3,4) a été reproduite 6 fois soit fact(4) divisée par 4
D est remplie sur le même principe que E sauf que la liste d'index ne serait pas identique. (voir la macro indexer())

tablo = Array(1, 2, 3, 4)

En espérant avoir été beaucoup plus clair dans mes explications.😛
Cibleo

 

[Bebere]

Re : Dans une boucle, déterminer une variable tableau et ventiler ses éléments

bonjour Cibleo
en module1 ton code avec Sub Les_Manquants1 intégré dans Sub boucler_ventiler
Tablo1 variable publique déclarée en module1
en module 2 un autre code avec variable mondico qui sert à indexé tableau plage

 

[cibleo]

Re : Dans une boucle, déterminer une variable tableau et ventiler ses éléments

Bonjour bebere et merci pour ta réponse

Hum c'est pas vraiment ça 🙁
A chaque index parcouru en colonne A (soit 12 itérations dans l'exemple fourni), les éléments de la variable constituée des manquants seront différents.
Pour l'index "1" ----> la variable sera (3,4)
"2" ----> (4,1)
"3" ----> (1,2)
"4" ----> (2,3)
"5" ----> (4,2)
"6" ----> (1,3)
"7" ----> (2,4)
"8" ----> (3,1)
"9" ----> (2,3)
"10" ----> (3,4)
"11" ----> (4,1)
"12" ----> (1,2)

Donc si j'appelle la macro ci dessous dans la macro boucler_ventiler(), les "ranges" sur lesquelles je m'appuie pour ressortir les manquants devront changées :
Pour l'index "1", je m'appuie sur :

tbl1 = Range("C2:F2")
tbl2 = Range("C6", Cells(6, Columns.Count).End(xlToLeft))

Sub Les_Manquants4()
'cette macro détermine une variable Manquants contenant des éléments manquants
Dim i As Long, k As Byte, j As Byte, v As Byte
Dim tbl1 As Variant, tbl2 As Variant, Manquants()
tbl1 = Range("C2:F2") ': i = 1
tbl2 = Range("C6", Cells(6, Columns.Count).End(xlToLeft))
'je boucle sur chaque élément de la plage ("C2:F2")
For k = LBound(tbl1, 2) To UBound(tbl1, 2)
  'je boucle sur chaque élément de la plage ("C6:D6")
  For j = LBound(tbl2, 2) To UBound(tbl2, 2)
  'si il y a concordance :v est vrai :on sort de la boucle :sinon on continue
    If tbl1(1, k) = tbl2(1, j) Then v = 1: Exit For
  Next j
  If v = 1 Then 'si v= 1 rien
    Else 'sinon
    i = i + 1 'on incrémente le tableau Manquants
    ReDim Preserve Manquants(1 To i)
    Manquants(i) = tbl1(1, k) 'le manquant est egal a la valeur non trouvée
  End If
  v = 0 ' on reinitialise V
Next k ' on continue
'Transpose Manquants à partir de G5
Range("G5").Resize(1, UBound(Manquants)) = Manquants
End Sub

Pour l'index "2", je m'appuierai sur :

tbl1 = Range("C3:F3")
tbl2 = Range("C7", Cells(7, Columns.Count).End(xlToLeft))

Pour déterminer tbl1, il faut que je fasse un Find sur la 1ère colonne de la petite matrice.
Cibleo

 

[Bebere]

Re : Dans une boucle, déterminer une variable tableau et ventiler ses éléments

oui,Cibleo je m'en doutais un peu
changé le code dans module2,ajout de x et y variables publiques

 

[cibleo]

Re : Dans une boucle, déterminer une variable tableau et ventiler ses éléments

Bonjour à tous 🙂
Bonjour Bebere 🙂

Bebere, ce n'est pas encore çà.
Voilà, j'ai trouvé sans passer par l'objet Dictionary que je ne maitise pas vraiment.
Je vous rapporte ma solution:
Passer en mode pas à pas pour bien comprendre la problématique :

'Option Explicit
Dim Manquants()
Sub boucler_ventiler()
'remplit la colonne E
Dim Plage As Range, Plage1 As Range, Plage2 As Range
Dim DerCel As Range, c As Range, Cel1 As Range, Cel2 As Range
Dim tablo, Tbl(), n As Long, i As Long, j As Byte, lig As Long, firstAddress As String
With Feuil2
  Set Plage = .Range("A6:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
  Set DerCel = .Range("A" & .Rows.Count).End(xlUp)
  n = Plage.Count
  ReDim Tbl(1 To n)
  'liste sans doublon des index de la colonne A
  tablo = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12)
  'Je boucle pour trouver chaque index en colonne A
  For i = 0 To UBound(tablo)
    Set c = Plage.find(tablo(i), DerCel, xlValues, xlWhole, xlByColumns, xlNext, False)
    If Not c Is Nothing Then
      firstAddress = c.Address: lig = c.Row
      Set Plage1 = .Range(.Cells(lig, 3), .Cells(lig, .Columns.Count).End(xlToLeft))
      Set Cel1 = .Cells(lig, .Columns.Count).End(xlToLeft)
      Set Cel2 = .Range("C1:C4").find(Cel1.Value, , xlValues, xlWhole, xlByColumns, xlNext, False, , False)
      Set Plage2 = .Range(.Cells(Cel2.Row, 3), .Cells(Cel2.Row, .Columns.Count).End(xlToLeft))
      'Call Les_Manquants4 Plage2, Plage1
      Call Les_Manquants4(.Range(.Cells(Cel2.Row, 3), .Cells(Cel2.Row, .Columns.Count).End(xlToLeft)), .Range(.Cells(lig, 3), .Cells(lig, .Columns.Count).End(xlToLeft)))
      j = 0
      Do
          j = j + 1
          If j > UBound(Manquants) Then j = 1
          Tbl(lig - 5) = Manquants(j)
          'Set c = Plage.FindNext(c) ---> ne convient pas
          ' le remède
          Set c = Plage.find(What:=tablo(i), After:=c, LookIn:=xlValues _
                  , LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
                    MatchCase:=False, SearchFormat:=False)
          lig = c.Row
      Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
  Next i
  'j'affecte les différents éléments en colonne E
  Range("E6").Resize(UBound(Tbl), 1) = Application.Transpose(Tbl)
End With
End Sub

Sub Les_Manquants4(Plage_A As Range, Plage_B As Range)
'cette macro détermine une variable Manquants contenant des éléments manquants
Dim i As Byte, k As Byte, j As Byte, v As Byte, tbl1, tbl2
tbl1 = Plage_A: tbl2 = Plage_B
'je boucle sur chaque élément de la plage Plage_A
For k = LBound(tbl1, 2) To UBound(tbl1, 2)
  'je boucle sur chaque élément de la plage Plage_B
  For j = LBound(tbl2, 2) To UBound(tbl2, 2)
    'si il y a concordance :v est vrai :on sort de la boucle :sinon on continue
    If tbl1(1, k) = tbl2(1, j) Then v = 1: Exit For
  Next j
  If v = 1 Then 'si v= 1 rien
  Else 'sinon
    i = i + 1 'on incrémente le tableau Manquants
    ReDim Preserve Manquants(1 To i)
    Manquants(i) = tbl1(1, k) 'le manquant est egal a la valeur non trouvée
  End If
  v = 0 ' on reinitialise V
Next k ' on continue
End Sub

cibleo

 

[Bebere]

Re : Dans une boucle, déterminer une variable tableau et ventiler ses éléments

bonjour Cibleo
commentaire dans feuil2
code module2

 

[cibleo]

Re : Dans une boucle, déterminer une variable tableau et ventiler ses éléments

Bonjour Bebere,

Çà m'a l'air d'être ça, mais je ne comprends pas pourquoi les éléments de la petite matrice s'effacent quand on exécute ta macro, résultat le résultat est biaisé.

Dans ton fichier, complète la petite matrice comme initialement présentée, efface la colonne E à partir de E6 puis exécute à nouveau ta macro, tu verrras.
Dictionary, c'est quand même hyper compliqué 😛, faut que j'analyse tout ça tranquillement.

Cibleo

 

[Bebere]

Re : Dans une boucle, déterminer une variable tableau et ventiler ses éléments

bonjour Cibleo
dans le code module2
.Range("E6:E29").ClearContents

dans le code module3
With Feuil2
lig = .Range("E" & .Rows.Count).End(xlUp).Row'ajout
If lig > 5 Then .Range("E6:E" & lig).ClearContents'changé

 

[cibleo]

Re : Dans une boucle, déterminer une variable tableau et ventiler ses éléments

Re bonsoir à tous,

Pour ma part, j'ai un peu revu ma macro en reprenant une routine de J-Boisgontier pour déterminer les manquants (c'est plus simple).
Bebere, j'ai abandonné le débogage, je sature sur ce coup là.
Pour remplir la colonne E, cela donne le bon resultat.
J'ai voulu modifier ta macro pour poursuivre avec la dernière colonne soit la F, j'ai capitulé.
Evidemment, il faut avant relancer la macro "indexer" préalablement.

'Option Explicit
Dim Manquants()
Sub boucler_ventiler()
'remplit la colonne E
Dim Plage As Range, Plage1 As Range, Plage2 As Range, dico As Object
Dim DerCel As Range, c As Range, Cel1 As Range, Cel2 As Range
Dim tablo, tablo1, Tbl(), n As Long, i As Long, j As Byte, lig As Long, firstAddress As String
With Feuil2
  Set dico = CreateObject("Scripting.Dictionary")
  Set Plage = .Range("A6:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
  Set DerCel = .Range("A" & .Rows.Count).End(xlUp)
  n = Plage.Count
  ReDim Tbl(1 To n)
  tablo1 = Plage
  For i = LBound(tablo1) To UBound(tablo1)
    dico(tablo1(i, 1)) = ""
  Next i
  'liste sans doublon des index de la colonne A
  tablo = dico.keys 'Exemple : tablo = Array(1, 2, 3, 4)
  'Je boucle pour trouver chaque index en colonne A
  For i = 0 To UBound(tablo)
    Set c = Plage.find(tablo(i), DerCel, xlValues, xlWhole, xlByColumns, xlNext, False)
    If Not c Is Nothing Then
      firstAddress = c.Address: lig = c.Row
      Set Plage1 = .Range(.Cells(lig, 3), .Cells(lig, .Columns.Count).End(xlToLeft))
      Set Cel1 = .Cells(lig, .Columns.Count).End(xlToLeft)
      Set Cel2 = .Range("C1:C4").find(Cel1.Value, , xlValues, xlWhole, xlByColumns, xlNext, False, , False)
      Set Plage2 = .Range(.Cells(Cel2.Row, 3), .Cells(Cel2.Row, .Columns.Count).End(xlToLeft))
      Call Les_Manquants(Plage1, Plage2)
      j = 0
      Do
          If j > UBound(Manquants) Then j = 0
          Tbl(lig - 5) = Manquants(j)
          j = j + 1
          'Set c = Plage.FindNext(c) ---> ne convient pas
          ' le remède
          Set c = Plage.find(What:=tablo(i), After:=c, LookIn:=xlValues _
                  , LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
                    MatchCase:=False, SearchFormat:=False)
          lig = c.Row
      Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
  Next i
  'j'affecte les différents éléments en colonne E
  Range("E6").Resize(UBound(Tbl), 1) = Application.Transpose(Tbl)
End With
End Sub

Sub Les_Manquants(champ1 As Range, champ2 As Range) 'Jacques Boisgontier
Dim MonDico1 As Object, MonDico2 As Object, c As Range
  Set MonDico1 = CreateObject("Scripting.Dictionary")
  For Each c In champ1: MonDico1(c.Value) = 1: Next c
  Set MonDico2 = CreateObject("Scripting.Dictionary")
  For Each c In champ2
    If Not MonDico1.exists(c.Value) Then MonDico2(c.Value) = ""
  Next c
  If MonDico2.Count > 0 Then Manquants = MonDico2.keys
End Sub

Cibleo

 

[Bebere]

Re : Dans une boucle, déterminer une variable tableau et ventiler ses éléments

bonjour Cibleo
Le code que j'ai fait vient en partie de JB
Je ne vois aucune demande de ta part pour la colonne f
pourtant j'ai pensé qu'il fallait compléter la ligne
conclusion: problème bien posé résolution plus facile pour celui qui veut t'aider
met un exemple de résultat à obtenir,j'essayerai d'en tirer quelque chose

 

[Bebere]

Re : Dans une boucle, déterminer une variable tableau et ventiler ses éléments

bonjour Cibleo
changé ton code aussi

 

[klin89]

Re : Dans une boucle, déterminer une variable tableau et ventiler ses éléments

Bonsoir à tous, 🙂

Au vu du schéma employé, on remarque que la répétition des index figurant en colonne A s'effectue à intervalles réguliers.
Dans ce cas, on peut se passer d'un "find".
Une boucle avec un pas fixé à data.Count devrait convenir.
La macro va remplir successivement les 3 dernières colonnes (D, E et F) de la grande matrice en s'appuyant sur les index de la colonne A (les index étant renouvelés à chaque itération de la boucle For col = 4 To 6)
Point de départ de la macro à exécuter : la petite matrice et la 1ère colonne de la grande matrice sont déjà pré-remplies (pas de cellules vides).
J'ai aussi revu la macro d'indexation de la colonnne A.

Sub macro3()
'Dans VBA, menu Outils/références, cochez Microsoft Scripting Runtime.
Dim data As New Dictionary, Plage1 As Range, Plage2 As Range
Dim i As Long, j As Long, k As Byte, m As Byte, pas As Long
Dim Tbl(), T(), tablo, lig1 As Long, lig2 As Byte, col As Byte
With Feuil1
  'remplit successivement les colonnes D, E et F de la grande matrice
  For col = 4 To 6
    Call Indexer_en_colonne_A
    tablo = .Range(.Cells(6, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, .Columns.Count).End(xlToLeft))
    For i = 1 To UBound(tablo)
      'si l'index en colonne A n'existe pas dans le dictionnaire
      If data.Exists(CStr(tablo(i, 1))) = False Then
        'on l'ajoute, et la valeur correspondante est la cellule située
        'la plus à droite ds la grande matrice au regard de la colonne A
        data.Add Key:=CStr(tablo(i, 1)), Item:=tablo(i, UBound(tablo, 2))
        lig1 = i + 5
        lig2 = .Range("C1:C4").Find(data.Items(i - 1), , xlValues, xlWhole, xlByColumns, xlNext, False).Row
        Set Plage1 = .Range(.Cells(lig1, 3), .Cells(lig1, .Columns.Count).End(xlToLeft))
        Set Plage2 = .Range(.Cells(lig2, 3), .Cells(lig2, .Columns.Count).End(xlToLeft))
        Call Les_Manquants(Plage1, Plage2)
        k = UBound(Manquants) + 1
        ReDim Preserve Tbl(1 To k, 1 To i)
        For j = 1 To UBound(Manquants) + 1
          Tbl(j, i) = Manquants(j - 1)
        Next j
      End If
    Next i
    ReDim T(1 To UBound(tablo))
    pas = 0
    For i = 0 To data.Count - 1
      For j = 1 + pas To UBound(tablo) Step data.Count
        m = m + 1
        T(j) = Tbl(m, i + 1)
        If m > UBound(Manquants) Then m = 0
      Next j
      pas = pas + 1
    Next i
    .Cells(6, col).Resize(UBound(T), 1) = Application.Transpose(T)
    data.RemoveAll: Erase Tbl, tablo, T
  Next col
End With
End Sub

Dim Manquants()
Sub Indexer_en_colonne_A()
'Dans VBA, menu Outils/références, cochez Microsoft Scripting Runtime.
Dim Dico As Dictionary, tablo, i As Byte, lig As Long, Cle As Long, temp As String
Set Dico = New Dictionary
With Feuil1
  Cle = 1
  tablo = .Range(.Cells(6, 3), .Cells(.Cells(.Rows.Count, 3).End(xlUp).Row, .Columns.Count).End(xlToLeft))
  'For lig = 6 To Range("C" & .Rows.Count).End(xlUp).Row
  For lig = 6 To .Cells(.Rows.Count, 3).End(xlUp).Row
    temp = ""
    For i = 1 To UBound(tablo, 2)
      temp = temp & tablo(lig - 5, i)
    Next i
    If Not Dico.Exists(temp) Then
      Dico.Add temp, Cle
      .Cells(lig, 1).Value = Cle
      Cle = Cle + 1
    Else
      .Cells(lig, 1).Value = Dico.Item(temp)
    End If
  Next lig
End With
Set Dico = Nothing
End Sub

Klin89

 

[klin89]

Re : Dans une boucle, déterminer une variable tableau et ventiler ses éléments

Bonsoir le forum,

En supprimant ReDim Preserve Tbl, c'est mieux.

Sub macro3()
'Dans VBA, menu Outils/références, cochez Microsoft Scripting Runtime.
Dim data As New Dictionary, Plage1 As Range, Plage2 As Range
Dim i As Long, j As Long, x As Long, y As Byte, m As Byte, k As Long
Dim Tbl(), T(), tablo, lig1 As Long, lig2 As Byte, col As Byte
With Feuil1
  'remplit successivement les colonnes D, E et F de la grande matrice
  For col = 4 To 6
    Call Indexer_en_colonne_A
    x = Application.WorksheetFunction.Max(.Range(.Cells(6, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 1)))
    y = Application.WorksheetFunction.CountBlank(.Range("C6:F6"))
    ReDim Tbl(1 To x, 1 To y)
    tablo = .Range(.Cells(6, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, .Columns.Count).End(xlToLeft))
    For i = 1 To UBound(tablo)
      'si l'index en colonne A n'existe pas dans le dictionnaire
      If data.Exists(CStr(tablo(i, 1))) = False Then
        'on l'ajoute, et la valeur correspondante est la cellule située
        'la plus à droite ds la grande matrice au regard de la colonne A
        data.Add Key:=CStr(tablo(i, 1)), Item:=tablo(i, UBound(tablo, 2))
        lig1 = i + 5
        lig2 = .Range("C1:C4").Find(data.Items(i - 1), , xlValues, xlWhole, xlByColumns, xlNext, False).Row
        Set Plage1 = .Range(.Cells(lig1, 3), .Cells(lig1, .Columns.Count).End(xlToLeft))
        Set Plage2 = .Range(.Cells(lig2, 3), .Cells(lig2, .Columns.Count).End(xlToLeft))
        Call Les_Manquants(Plage1, Plage2)
        For j = 1 To UBound(Manquants) + 1
          Tbl(i, j) = Manquants(j - 1)
        Next j
      Else: Exit For
      End If
    Next i
    ReDim T(1 To UBound(tablo))
    k = 0
    For i = 1 To data.Count
      For j = 1 + k To UBound(tablo) Step data.Count
        m = m + 1
        T(j) = Tbl(i, m)
        If m > UBound(Manquants) Then m = 0
      Next j
      k = k + 1: m = 0
    Next i
    .Cells(6, col).Resize(UBound(T), 1) = Application.Transpose(T)
    data.RemoveAll: Erase Tbl, tablo, T
  Next col
End With
End Sub

Klin89