Automatisation de rapprochement sur plusieurs lignes

[jessica.francois]

Bonjour à tous,

J'ai besoin de votre aide !!

Dans le cadre de mon travail, je dois créer un fichier à partir de la jointure de 2 tableaux.
Le problème : pour 1 critère le nombre de ligne n'est pas unique dans le second tableau ...

J'ai préparé un petit fichier exemple que vous trouverez en pièce jointe qui illustrera bien mieux mon problème qu'une longue explication textuelle !

J'ai plusieurs 10aines de milliers de lignes à traiter donc une solution automatique est la bienvenue !!!!

Merci d'avance de votre aide !!!

Jessica

 

[pierrejean]

Re : Automatisation de rapprochement sur plusieurs lignes

Bonjour jessica.francois

Et bienvenue sur XLD

Vois si cela te convient (le resultat est en Feuil2 ,je te laisse le transferer dans un fichier )
Ps :Si toutefois tu veux aussi automatiser le transfert, reviens en me precisant le nom du fichier qui doit recevoir

 

[jessica.francois]

Re : Automatisation de rapprochement sur plusieurs lignes

Ca m'a l'air impeccable !!

Merci beaucoup !!!

 

[jessica.francois]

Re : Automatisation de rapprochement sur plusieurs lignes

Re-Bonjour,

Dès que je je fais tourner la macro sur toute mes données ... on va dire qu'Excel a un peu de mal (4h que la macro tourne là ...) et je ne suis même pas sûre que les 1 Million de lignes suffiront ...

Est il possible que le fichier de sortie soit un fichier Access ou un fichier plat .txt ?

Merci d'avance pour votre aide !

Cdt,

Jessica

 

[pierrejean]

Re : Automatisation de rapprochement sur plusieurs lignes

Re

Teste cette version qui est un peu plus rapide (entre 3 et 4 fois plus rapide que la precedente)

 

[jessica.francois]

Re : Automatisation de rapprochement sur plusieurs lignes

Ca va en effet beaucoup (beaucoup beaucoup) plus vite. Cependant, le resultat la colonne E du fichier résultat est fausse, il faut faire revenir la colonne C de l'onglet Mapping. Ce n'est cependant pas très grave car un simple recherchev me permet de corriger cela.

J'ai une erreur code 13 mais en découpant mon fichier cela fonctionne cependant ...

Merci beaucoup !!

 

[pierrejean]

Re : Automatisation de rapprochement sur plusieurs lignes

Re

Version corrigée du code pour colonne E

Sub reportb()
'debut = Timer
Dim n As Long
Dim res()
ReDim res(4, 0)
Set d = CreateObject("scripting.dictionary")
For n = 2 To Sheets("Feuil1").Range("A" & Application.Rows.Count).End(xlUp).Row
  x = Sheets("Feuil1").Range("A" & n) & ";" & Sheets("Feuil1").Range("B" & n) & ";" & Sheets("Feuil1").Range("C" & n)
  d(x) = x
Next n
a = d.keys
tablo = Sheets("Mapping").Range("A2:C" & Sheets("Mapping").Range("A" & Application.Rows.Count).End(xlUp).Row)
Application.ScreenUpdating = False
Sheets("Feuil2").Range("A2:E" & Application.Rows.Count).ClearContents
For n = LBound(a) To UBound(a)
  xx = Split(a(n), ";")(2)
  For m = LBound(tablo, 1) To UBound(tablo, 1)
     If tablo(m, 1) = xx Then
       res(0, UBound(res, 2)) = Split(a(n), ";")(0)
       res(1, UBound(res, 2)) = Split(a(n), ";")(2)
       res(2, UBound(res, 2)) = tablo(m, 2)
       res(3, UBound(res, 2)) = ".1 Création"
       res(4, UBound(res, 2)) = tablo(m, 3)
       ReDim Preserve res(4, UBound(res, 2) + 1)
     End If
  Next m
Next n
Application.ScreenUpdating = True
Sheets("Feuil2").Select
Sheets("Feuil2").Range("A3").Resize(UBound(res, 2), 5) = Application.Transpose(res)
'MsgBox (Timer - debut)
End Sub

Sur quelle ligne l'erreur 13 et si possible que dit-elle ?

 

[jessica.francois]

Re : Automatisation de rapprochement sur plusieurs lignes

Bonjour,

Je viens de voir votre réponse ... (c'est bizarre je n'ai pas eu de mail pour me dire que j'avais reçu une réponse) je me suis débrouillée toute seule pour corriger l'erreur à la main et je ne me souviens pas du message d'erreur !

Par contre j'ai un nouveau traitement à réaliser, le code dans le VBA sera plus ou moins la même chose derrière mais je souhaite avoir le résultat dans un Access ou directement dans un ou plusieurs fichiers textes (en pièce jointe il s'agit d'un exemple mais mon fichier complet comporte 65k lignes à traiter et le mapping environ 20k lignes) ...
je pense que mon résultat sera autour des 10 millions de lignes ....

je pense que mon fichier est clair, si vous avez des questions n'hesitez pas

Qu'est ce que vous en pensez ?

Merci d'avance !

Cdt,

Jessica

 

[pierrejean]

Re : Automatisation de rapprochement sur plusieurs lignes

Re

Voila

Tourne en environ 0,86 seconde pour 3500 lignes de resultat ce qui donnerait un theorique de 48 minutes pour 10 000 000 de lignes
tiens moi au courant

 

[pierrejean]

Re : Automatisation de rapprochement sur plusieurs lignes

Re

Version avec production d'un fichier .txt supplementaire

 

[jessica.francois]

Re : Automatisation de rapprochement sur plusieurs lignes

Super, je vais essayer ça au calme et je vous tiens au courant !

Merci beaucoup !

 

[jessica.francois]

Re : Automatisation de rapprochement sur plusieurs lignes

le .txt créé correspond à l'onglet automatisation p2. Il me faut l'onglet feuil1 (enfin l'onglet de résultat) dans le fichier texte.
Petite question : le fait que le résultat ce sauvegarde après "macro" dans un texte ne va pas limiter son nombre de ligne à 1 million puisque cela passe par Excel avant ?

 

[pierrejean]

Re : Automatisation de rapprochement sur plusieurs lignes

Re

Version qui enregistre bien la bonne feuille
Si il y aura bien limitation au nombre de lignes d'excel 2010 (un peu plus d'un million)
Pour y echapper il faudrait enregistrer directement en TXT mais je ne sais pas faire
Je regarde si j'ai le temps

 

[jessica.francois]

Re : Automatisation de rapprochement sur plusieurs lignes

Ok ! Merci beaucoup

 

[pierrejean]

Re : Automatisation de rapprochement sur plusieurs lignes

Re

A tester : Macro pour obtenir directement le fichier .txt

Sub test1()
Sheets("Feuil1").Range("A2:D" & Application.Rows.Count).ClearContents
Dim res()
Dim n As Long
ReDim res(3, 0)
Dim fs, a
tablo = Sheets("A traiter").Range("A2:C" & Sheets("A traiter").Cells(Application.Rows.Count, 1).End(xlUp).Row)
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile("E:\texcel2\automatisation p2.txt", True)
a.WriteLine ("Matricule" & Chr(9) & "Action" & Chr(9) & "Rôle" & Chr(9) & "Transaction")
For n = LBound(tablo, 1) To UBound(tablo, 1)
With Sheets("nouveau mapping").Columns(1)
Set c = .Find(tablo(n, 3), LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
 firstAddress = c.Address
 Do
   a.WriteLine (tablo(n, 1) & Chr(9) & tablo(n, 2) & Chr(9) & tablo(n, 3) & Chr(9) & c.Offset(0, 1))
   Set c = .FindNext(c)
   Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
Next n
a.Close
End Sub