Codification des résultat d'un tableau

pierreed

XLDnaute Nouveau
Bonjour,

Voilà, je dois élaborer un fichier qui transpose les résultats du 1er tableau sous plusieurs formes (doc en PJ) :

- un tableau Fr
- un tableau liaison
- un tableau EN


La demande étant complexe à formuler uniquement par texte, je vous met à disposition un exemple :

http://www.sendbox.fr/e86d7aca2f336361/Codification.xlsx

Il y a également des contraintes qui sont les suivantes :

- Le formalisme des tableaux
- Les données dans le 1er tableau sont aléatoire.
- Les données saisies peuvent aller de 20 lignes jusqu'à 200 lignes, pas de limites non plus.

J'ai tout testé mais là je bloque vraiment, rien ne marche xD

Sachant qu'il y a un autre tri par la suite de ces données (qui est en place et qui fonctionne).

Dans l'attente de votre aide,

Pierreed
 

pierreed

XLDnaute Nouveau
Bonjour Dranreb,

Merci du temps que tu as accordé a ma problématique.

Lorsque je lance ton programme, il stipule "type par utilisateur non défini" j'ai trouvé différentes solutions sur le web mais aucune qui correspond, étant novice dans Visual Basic (pour ne pas dire que c'est la première fois que j'y suis confronté) saurais-tu comment passé ce bloquage ?
 

Dranreb

XLDnaute Barbatruc
Bonjour.
Vous parlez du classeur que j'ai joint, ou d'un un autre où vous essayez de l'implanter ?
Le type Dictionary est défini par la bibliothèque Scripting, qu'il faut donc associer au projet VBA.
Référence "Miscrosoft Scripting Runtime" à cocher, menu Outils, Références…
 

Dranreb

XLDnaute Barbatruc
Notez que ça peut aussi s'écrire avec des collections :
VB:
Option Explicit
Private TDon(), EnsLst As Collection, EnsSuj As Collection, EnsFct As Collection
Sub TransTout()
   Dim L As Long, TRés(1 To 1000, 1 To 4)
'   TDon = Feuil1.[A2:E6].Value
   With Feuil1.[A1].CurrentRegion: TDon = .Rows(2).Resize(.Rows.Count - 1).Value: End With
   Set EnsLst = New Collection
   Set EnsSuj = New Collection
   Set EnsFct = New Collection
   For L = 1 To UBound(TDon, 1)
      TRés(L, 1) = "L" & NuméroAssumé(EnsLst, TDon(L, 1))
      TRés(L, 2) = "S" & NuméroAssumé(EnsSuj, TDon(L, 2))
      TRés(L, 3) = "F" & NuméroAssumé(EnsFct, TDon(L, 3))
      TRés(L, 4) = "I" & L
      Next L
   Feuil1.[E27:H50].Value = TRés
   TransLangue Feuil1.[A27:C50], "FR"
   TransLangue Feuil1.[J27:L50], "EN"
   Erase TDon
   Set EnsLst = Nothing
   Set EnsSuj = Nothing
   Set EnsFct = Nothing
   End Sub
Function NuméroAssumé(ByVal Ens As Collection, ByVal Clé As String) As Long
   On Error Resume Next: NuméroAssumé = Ens(Clé)
   If Err Then NuméroAssumé = Ens.Count + 1: Ens.Add Key:=Clé, Item:=NuméroAssumé
   End Function
Sub TransLangue(ByVal RngRés As Range, ByVal Langue As String)
   Dim CItm As Long, TRés(), LD As Long, Clé As String, LR As Long, _
      TUtiL() As Boolean, TUtiS() As Boolean, TUtiF() As Boolean, Num As Long
   ReDim TUtiL(1 To EnsLst.Count), TUtiS(1 To EnsSuj.Count), TUtiF(1 To EnsFct.Count)
   CItm = IIf(Langue = "FR", 4, 5)
   ReDim TRés(1 To RngRés.Rows.Count, 1 To 3)
   For LD = 1 To UBound(TDon, 1)
      Clé = TDon(LD, 1): Num = NuméroAssumé(EnsLst, Clé): If Not TUtiL(Num) Then TUtiL(Num) = True: _
         LR = LR + 1: TRés(LR, 1) = "L" & Num: TRés(LR, 2) = Langue: TRés(LR, 3) = Clé
      Clé = TDon(LD, 2): Num = NuméroAssumé(EnsSuj, Clé): If Not TUtiS(Num) Then TUtiS(Num) = True: _
         LR = LR + 1: TRés(LR, 1) = "S" & Num: TRés(LR, 2) = Langue: TRés(LR, 3) = Clé
      Clé = TDon(LD, 3): Num = NuméroAssumé(EnsFct, Clé): If Not TUtiF(Num) Then TUtiF(Num) = True: _
         LR = LR + 1: TRés(LR, 1) = "F" & Num: TRés(LR, 2) = Langue: TRés(LR, 3) = Clé
      LR = LR + 1: TRés(LR, 1) = "I" & LD: TRés(LR, 2) = Langue: TRés(LR, 3) = TDon(LD, CItm)
      Next LD
   RngRés.Value = TRés
   End Sub
 

Dranreb

XLDnaute Barbatruc
Bonjour.
Je n'avais pas vu 'MAC' sinon je n'aurais pas proposé quelque chose avec des Dictionary. Je n'aurais sans doute même pas répondu, d'ailleurs. Désolé. Avec les collections, ça ne marche pas non plus ? Qu'est-ce qui plante pour la pomme avec ce code ?
 

Discussions similaires

Réponses
16
Affichages
409

Statistiques des forums

Discussions
311 725
Messages
2 081 941
Membres
101 846
dernier inscrit
Silhabib