XL 2013 [VBA] Boucle variable tableau

titiborregan5

XLDnaute Accro
Bonjour à tous,

je suis confronté à un problème, et malgré mes recherches sur le net je n'y arrive pas.
Je ne parviens pas à manipuler correctement les variables tableau ce qui me complique la tâche.

J'ai une grande quantité de données 500K lignes, en 6 colonnes dont les colonnes importantes sont:
  1. Nom du rôle
  2. Nom de l'entry point
  3. Niveau d'accès
  4. Concaténation 1&"/"&2
Ces 500K lignes correspondent aux 36 rôles * 15K entry points à chaque fois.

J'aimerais, pour pouvoir comparer les rôles entre eux (habilitations informatiques d'un ERP), créer un tableau à double entrée, en ligne les 15K entry points et en colonne les 36 rôles et où le croisement donne le niveau d'accès.
Si je fais ça via une formule, ça rame pendant des heures et bloque mon pc.
Si je fais avec une macro où j'utilise 2 boucles avec un .find ou .match ça bloque aussi mon pc.

Je me suis dit : gros volume de données, faut passer par les variables tableaux. Mais je ne sais pas comment faire avec ces variables (lignes & colonnes).
Si j'ai bien compris, avec les tableaux on utilise pas les boucles for ... next ?

J'espère que mon problème est posé de façon compréhensible?
J'ai mis mon fichier en PJ zip avec qq bouts de code trouvés sur la toile, l'objectif étant de remplir l'onglet Combin à partir de la base Rôles DAT R2.
Merci d'avance
T
 
Dernière édition:

Dranreb

XLDnaute Barbatruc
Bonjour.
Si, on utilise des boucles For Next pour traiter ce ce que contiennent les tableaux.
C'est pour leur chargement ou déchargement intégral, en une seul instruction chacun, qu'on ne doit pas les utiliser. l'accès à un Range est en effet long et presque indépendant du nombre de cellules. On peut considérer qu'un accès à 1000 cellules vers un tableau est 1000 fois plus rapide que 1000 acces à une seule cellule chaque fois.
Cela dit pour de gros volumes, il vaut mieux trouver une solution de rechange aux deux boucles imbriquées. Par exemple mettre tout les éléments de l'un dans un Dictionary à l'aide d'une boucle puis le consulter dans une autre boucle indépendante qui explore le second.
 
Dernière édition:

Dranreb

XLDnaute Barbatruc
En cochant la référence Microsoft Scripting Runtime j'ai un résultat immédiat avec ce code :
VB:
Option Explicit

Sub Combin()
Dim DicCol As New Dictionary, DicLig As New Dictionary, TE(), LE&, TS(), L&, C&
TE = Feuil3.[C1:AJ1].Value
For C = 1 To UBound(TE, 2): DicCol(TE(1, C)) = C: Next C
TE = Feuil3.[B2].Resize(Feuil3.[B1000000].End(xlUp).Row - 1).Value
For L = 1 To UBound(TE, 1): DicLig(TE(L, 1)) = L: Next L
ReDim TS(1 To L - 1, 1 To C - 1)
TE = Feuil1.UsedRange.Value
For LE = 2 To UBound(TE, 1)
   If DicCol.Exists(TE(LE, 1)) And DicLig.Exists(TE(LE, 3)) Then
      C = DicCol(TE(LE, 1)): L = DicLig(TE(LE, 3))
      TS(L, C) = TE(LE, 4): End If: Next LE
Feuil3.[C2].Resize(UBound(TS, 1), UBound(TS, 2)).Value = TS
End Sub
 

titiborregan5

XLDnaute Accro
En cochant la référence Microsoft Scripting Runtime j'ai un résultat immédiat avec ce code :
VB:
Option Explicit

Sub Combin()
Dim DicCol As New Dictionary, DicLig As New Dictionary, TE(), LE&, TS(), L&, C&
TE = Feuil3.[C1:AJ1].Value
For C = 1 To UBound(TE, 2): DicCol(TE(1, C)) = C: Next C
TE = Feuil3.[B2].Resize(Feuil3.[B1000000].End(xlUp).Row - 1).Value
For L = 1 To UBound(TE, 1): DicLig(TE(L, 1)) = L: Next L
ReDim TS(1 To L - 1, 1 To C - 1)
TE = Feuil1.UsedRange.Value
For LE = 2 To UBound(TE, 1)
   If DicCol.Exists(TE(LE, 1)) And DicLig.Exists(TE(LE, 3)) Then
      C = DicCol(TE(LE, 1)): L = DicLig(TE(LE, 3))
      TS(L, C) = TE(LE, 4): End If: Next LE
Feuil3.[C2].Resize(UBound(TS, 1), UBound(TS, 2)).Value = TS
End Sub
Hello,

désolé pour le silence radio.
J'ai essayé sur mon poste mais j'ai un message d'erreur lorsque je veux rajouter la référence Microsoft Scripting Runtime : "Erreur d'accès à la base de registration"...

Je viens de tester sur un autre poste, la macro s'exécute et se termine en 5 secondes environ (vieux PC). Par contre certaines lignes sont vides ???
Par exemple la ligne 149 est la 1ère ligne vide. Il y a je crois 777 lignes vides ( soit 26 418 cellules).

Ne comprenant pas vraiment le code que tu as fait, j'ai du mal à savoir pourquoi et comment corriger.
Je vais creuser tout de même si jamais j'avais une lumière...

Encore merci
 
Dernière édition:

titiborregan5

XLDnaute Accro
Bonjour,
ah ce mois de mai et ses ponts...
je vais faire tourner ta macro sur le fichier anonyme, voir si le pb persiste et si oui je le poste ici ASAP.
Désolé pour le temps de réponse ultra long et une nouvelle fois MERCI.

Edit : je viens de déposer la PJ: 1ère ligne vide : ligne 149
 
Dernière édition:

Dranreb

XLDnaute Barbatruc
En fait je n'avais pas vu qu'il y avait 2 éléments d'identification de la ligne.
Comme ça, ça devrait aller mieux :
VB:
Sub Combin()
Dim DicCol As New Dictionary, DicLig As New Dictionary, CléLig As String, TE(), LE&, TS(), L&, C&
TE = Feuil3.[C1:AJ1].Value
For C = 1 To UBound(TE, 2): DicCol(TE(1, C)) = C: Next C
TE = Feuil3.[A2:B2].Resize(Feuil3.[A1000000].End(xlUp).Row - 1).Value
For L = 1 To UBound(TE, 1): CléLig = TE(L, 1) & "|" & TE(L, 2): DicLig(CléLig) = L: Next L
ReDim TS(1 To L - 1, 1 To C - 1)
TE = Feuil1.UsedRange.Value
For LE = 2 To UBound(TE, 1)
   CléLig = TE(LE, 2) & "|" & TE(LE, 3)
   If DicCol.Exists(TE(LE, 1)) And DicLig.Exists(CléLig) Then
      C = DicCol(TE(LE, 1)): L = DicLig(CléLig)
      TS(L, C) = TE(LE, 4): End If: Next LE
Feuil3.[C2].Resize(UBound(TS, 1), UBound(TS, 2)).Value = TS
End Sub
 

titiborregan5

XLDnaute Accro
En fait je n'avais pas vu qu'il y avait 2 éléments d'identification de la ligne.
Comme ça, ça devrait aller mieux :
VB:
Sub Combin()
Dim DicCol As New Dictionary, DicLig As New Dictionary, CléLig As String, TE(), LE&, TS(), L&, C&
TE = Feuil3.[C1:AJ1].Value
For C = 1 To UBound(TE, 2): DicCol(TE(1, C)) = C: Next C
TE = Feuil3.[A2:B2].Resize(Feuil3.[A1000000].End(xlUp).Row - 1).Value
For L = 1 To UBound(TE, 1): CléLig = TE(L, 1) & "|" & TE(L, 2): DicLig(CléLig) = L: Next L
ReDim TS(1 To L - 1, 1 To C - 1)
TE = Feuil1.UsedRange.Value
For LE = 2 To UBound(TE, 1)
   CléLig = TE(LE, 2) & "|" & TE(LE, 3)
   If DicCol.Exists(TE(LE, 1)) And DicLig.Exists(CléLig) Then
      C = DicCol(TE(LE, 1)): L = DicLig(CléLig)
      TS(L, C) = TE(LE, 4): End If: Next LE
Feuil3.[C2].Resize(UBound(TS, 1), UBound(TS, 2)).Value = TS
End Sub
Merci Dranreb, ça marche nickel.
Je n'arrive pas à comprendre ton code mais ça marche, plus aucune ligne vide.

Un grand merci encore une fois!
Belle journée
 

Discussions similaires

Statistiques des forums

Discussions
312 084
Messages
2 085 194
Membres
102 810
dernier inscrit
mohammedaminelahbali