Jointure/Comparaison: Premier blocage d'une longue série

Agonyme Messages postés 6 Date d'inscription   Statut Membre Dernière intervention   -  
Agonyme Messages postés 6 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour à tous et à toutes:
Je suis en train de développer un outils en VBA et je suis confronté à une série de blocages divers étant donné que je ne suis pas très expérimenté.
Le premier d'entre eux est le suivant : je dispose de deux classeurs contenants une feuille chacun. Dans chacun des classeurs on retrouve une colonne "Numéro d'affaire" avec un identifiant unique commun aux deux ainsi que une colonne "D" contenant une date de début dans l'un et " D' " dans l'autre contenant la date de fin. Mon objectif est de récupérer dans un troisième classeur l'identifiant, la date de début et la date de fin. Pour ne pas simplifier la chose, dans le premier classeur on a environ 20 000 lignes et 5000 dans le second, il est donc impossible de se contenter de copier les colonnes tels quel car les clés ne correspondraient pas. Mon objectif premier dans ce cas serait de faire correspondre les lignes qui vont bien et de supprimer celles qui n'ont pas de date de fin.
J'ai tenté de coder un truc qui en plus d'être loin, très loin d'être optimal, ne fonctionne pas. 
Application.ScreenUpdating = False
ChDir "C:\Users\ACER\Appli\MOA"
ClasseurRegional = Dir("C:\Users\ACER\Appli\MOA\MOA.xls")


   Workbooks.Open ClasseurRegional 'Ouverture du fichier
   
   DerniereLigne = ActiveSheet.UsedRange.Rows.Count 'On prend la valeur du nombre de ligne
   Range("B10:B" & DerniereLigne).Copy 'Copie de A2 à C(NbLignes)
   Workbooks("Classeur1.xlsm").Sheets("Sheet2").Activate 'On met la feuille courante en active
   DebutNomFichier = Sheets("Sheet2").UsedRange.Rows.Count + 1 'Debut nom fichier prend la valeur nombre de lignes utilisées +1
   Range("B" & Sheets("Sheet2").UsedRange.Rows.Count + 1).Select ' On selectionne la colonne B de classseur jusqu'à la ligne utilisée max +1
   Sheets("Sheet2").Paste 'On colle dans la zone selectionnée
   Workbooks(ClasseurRegional).Close 'fermeture du fichier lu
   
   Workbooks.Open ClasseurRegional
   Range("J10:J" & DerniereLigne).Copy 'Copie de J10 à J(NbLignes)
   Workbooks("Classeur1.xlsm").Sheets("Sheet2").Activate 'On met la feuille courante en active
   DebutNomFichier = Sheets("Sheet2").UsedRange.Rows.Count + 1 'Debut nom fichier prend la valeur nombre de lignes utilisées +1
   Range("C2").Select 
   Sheets("Sheet2").Paste


ChDir "C:\Users\ACER\Appli\IEP"
ClasseurRegional = Dir("C:\Users\ACER\Appli\IEP\*.*")


nblignes = Workbooks("Classeur1.xlsm").Sheets("Sheet2").UsedRange.Rows.Count' compte du nombre de lignes collées
Workbooks.Open ClasseurRegional 'Ouverture du fichier
nblignes2 = Workbooks("IEP").Sheets("Export IEP").UsedRange.Rows.Count' compte du nombre de ligne à comparer

For i = 11 To nblignes ' 11 est la première ligne de données intéressante
    j = 0
    While j < nblignes2
        If Workbooks("Classeur1.xlsm").Sheets("Sheet2").Cells(i, 2).Value Like Workbooks("IEP.xlsx").Sheets("Export IEP").Cells(j, 1).Value Then
            Workbooks("IEP.xlsx").Sheets("Export IEP").Cells(j, 1).EntireRow.Copy
            Workbooks("Classeur1.xlsm").Sheets("Sheet2").Range("C" & i).Paste
            j = nblignes2 + 1
        Else
            j = j + 1
        End If
    Wend
Next
En gros la dernière partie de code tente de comparer chaque cellule identifiante du fichier à comparer avec les cellules identifiantes qu'on à déjà collé.
Merci de votre patience, votre aide me serait très précieuse.
Cordialement.

Edit : Les données sources manipulées sont confidentielles je présume donc je ne peux vous les fournir. Toutefois je peux essayer de vous créer un fichier équivalent si cela est necessaire
A voir également:

2 réponses

Réponse 1 / 2
michel_m Messages postés 16602 Date d'inscription   Statut Contributeur Dernière intervention   3 314
 
Bonjour,

Toutefois je peux essayer de vous créer un fichier équivalent si cela est necessaire

Plutôt les TROIS classeurs 

pour joindre une pièce
mettre le classeur sans données confidentielles en pièce jointe sur
http://cjoint.com/ 
puis copier l'adresse du lien et la coller dans le message de réponse
0
Agonyme Messages postés 6 Date d'inscription   Statut Membre Dernière intervention  
 
Au final je suis arrivé a des résultats plus convenables en important les données des deux classeurs sources dans celui de travail. Toutefois le temps d'exécution reste particulièrement long pour un volume réduit donc j'essaieras de trouver le temps de faire les fichiers exemples dans la semaine, merci de votre aide !
0
Agonyme Messages postés 6 Date d'inscription   Statut Membre Dernière intervention  
 
Voilà le fichier Exemple, https://www.cjoint.com/?DDCqZfEjsO6
Il faut toutefois noter que le volume réel de données est beaucoup plus conséquent (autour des 20000 lignes)
Merci d'avance
0
Réponse 2 / 2
michel_m Messages postés 16602 Date d'inscription   Statut Contributeur Dernière intervention   3 314
 
J'ai considéré que le tableau "fin" était plus petit que le tableau "début" (bin oui !) 

Option Explicit
Option Base 1

Sub coupler_2tableaux()
Dim Derlig  As Integer, T_f1, T_f2, Idx As Integer, Ref As String
Dim D_f1 As Object
Dim T_out, Cptr As Integer
Dim start As Single

Application.ScreenUpdating = False
start = Timer

With Sheets("données1")
     Derlig = .Columns("A").Find("*", , , , , xlPrevious).Row
     T_f1 = .Range("A8:B" & Derlig)
     Set D_f1 = CreateObject("scripting.dictionary")
      For Idx = 1 To UBound(T_f1)
           Ref = T_f1(Idx, 1)
           If Not D_f1.exists(Ref) Then D_f1.Add Ref, T_f1(Idx, 2)
       Next
End With

With Sheets("données2")
     Derlig = .Columns("A").Find("*", , , , , xlPrevious).Row
     T_f2 = .Range("A2:B" & Derlig)
End With

'Nbre de données 2 inférieur à nombre de données 1
ReDim T_out(3, 1)
For Idx = 1 To UBound(T_f2)
     If D_f1.exists(T_f2(Idx, 1)) Then
          Cptr = Cptr + 1
          ReDim Preserve T_out(3, Cptr)
          T_out(1, Cptr) = T_f2(Cptr, 1)
          T_out(2, Cptr) = D_f1.Item(T_f2(Cptr, 1))
          T_out(3, Cptr) = T_f2(Cptr, 2)
     End If
Next

With Sheets("tableau")
.Range("A2:C20000").Clear
     With .Range("A2").Resize(UBound(T_f2), 3)
          .Value = Application.Transpose(T_out)
          .Borders.Weight = xlThin
     End With
     .Activate
End With

Application.ScreenUpdating = True
MsgBox "Couplage affaires-début / fin effectué en: " & Timer - start & ".sec"

End Sub

la maquette de W
https://www.cjoint.com/?3DCsGZFoV81

Michel
0
michel_m Messages postés 16602 Date d'inscription   Statut Contributeur Dernière intervention   3 314
 
Une autre méthode certainement + rapide est possible en utilisant ADO et des jointures par SQL mais c'est Lundi....
0
Agonyme Messages postés 6 Date d'inscription   Statut Membre Dernière intervention  
 
Merci beaucoup ça semble correspondre à ce que je recherche (enfin j'ai un peu de mal à tout saisir mais bon). Cela dit, dans les classeurs de données, les deux colonnes de numéro d'affaire et de date ne sont pas contiguë (C - I et A - C) Du coup par quoi puis-je remplacer le range(A8:B"&Derlig) ?
0
michel_m Messages postés 16602 Date d'inscription   Statut Contributeur Dernière intervention   3 314
 
POURQUOI envoyer des exemples bidon qui sentent le "démerdes toi avec ça""???

Il faut bien te rendre compte que ce que tu demandes n'est pas forcément facile et que personne ne veut passer parfois plusieurs heures à essayer de résoudre un problème bénévolement pour se voir dire après coup « En fait, dans la réalité etc... il faut en plus que.... »
0
Agonyme Messages postés 6 Date d'inscription   Statut Membre Dernière intervention  
 
Je regrette, il ne s'agissait pas d'un exemple bidon mais plutôt représentatif mais c'est un détail qui m'a échappé. Je suis conscient du travail bénévole fourni et vous en remercie grandement. Je ne demande rien de plus, juste ce détail m'avait pas paru important mais il se trouve que il l'est en fait. Enfin bon vous pouvez considérer avoir fait ce qu'il fallait pour m'aider, j'essaierai de me débrouiller moi même avec mes inexactitudes. Merci
0
Agonyme Messages postés 6 Date d'inscription   Statut Membre Dernière intervention  
 
Voilà j'ai réglé le soucis, juste à retoucher les classeurs de données. Par contre une chose m'échappe, après la 1499 ème ligne, le tableau est rempli de #N/A , est-ce dû à un dépassement de mémoire où une variable trop longue à votre avis ?
0

Discussions similaires

Jointure et requête sur 3 tables
hakim_fth -
hakim_fth -

2 réponses