XL 2016 Transco avec multiples conditions

[KH94]

Bonjour à tous,

NB: Avant tout, je tiens à notifier que cette base est une base d'exemple pris sur un site d'exercice Access ( bonbache.fr)

Je suis nouveau dans le développement VBA ainsi que sur ce forum.

J'au un problème sur une correspondance multiples variables.

Je dispose de deux fichiers dans un même classeur.

le premier fichier est une base de données volumineux ( 50 000 lignes environ) avec les variables suivantes en tête de colonne ( Civilité, nom, prénom, nb. enfant, aides, code_id(que je veux remplir), ville).

le second fichier ne dispose que de quelques lignes avec comme entête de colonne: civilité, aides, ville, code_id ( ici les code sont déjà prédéfinit).

le problème: je dois vérifier chaque ligne du premier fichier (base de données) et si sur une ligne la civilité, aides et ville correspondent exactement à une ligne du second fichier (fichier de référence), je dois attribuer dans la session code_id de la ligne du premier fichier le code_id du second fichier.

honnêtement, je ne sais pas où commencer sous VBA.

 

[sylvanu]

Bonjour KH,
Un essai en PJ avec :

=INDEX(TRANSCO!D:D;EQUIV(A2&E2&F2;TRANSCO!A:A&TRANSCO!B:B&TRANSCO!C:C;0))

à valider en matriciel avec Maj+Ctrl+Entrée.
Mais sur 50 klignes, cela va être très long.
Une solution plus rapide serait du VBA. est ce possible ?

 

[KH94]

Bonjour KH,
Un essai en PJ avec :

=INDEX(TRANSCO!D:D;EQUIV(A2&E2&F2;TRANSCO!A:A&TRANSCO!B:B&TRANSCO!C:C;0))

à valider en matriciel avec Maj+Ctrl+Entrée.
Mais sur 50 klignes, cela va être très long.
Une solution plus rapide serait du VBA. est ce possible ?

Merci infiniment

Oui, je n'avais pas précisé mais c'est exactement une solution VBA que je cherche. C'est une partie de mon code, et vu que l'opération va se réaliser chaque semaine, un code VBA sera plus approprié. Merci

 

[sylvanu]

Re,
un essai en PJ avec :

Sub Colle_Code_ID()
    Application.ScreenUpdating = False
    T = Range("A2:F" & Range("A65500").End(xlUp).Row)   ' Transfert Base dans Array
    ReDim CodeId(UBound(T))                             ' Array Code_ID même taille que Base
    With Sheets("Transco")                              ' Transfert Transco dans Array
        Transco = .Range("A2:D" & .Range("A65500").End(xlUp).Row)
    End With
    For i = 1 To UBound(T)
        Civil = T(i, 1): Ville = T(i, 5): CAF = T(i, 6)
        For j = 1 To UBound(Transco)                ' Séparer les 3 IF accélère le process
            If Transco(j, 3) = CAF Then             ' si CAF ok
                If Transco(j, 2) = Ville Then       ' et Ville ok
                    If Transco(j, 1) = Civil Then   ' et civilité ok
                        CodeId(i) = Transco(j, 4)   ' alors on récupère le Code_ID
                        Exit For                    ' on a trouvé, donc on sort
                    End If
                End If
            End If
        Next j
    Next i
    CodeId(0) = "Code_ID"                           ' Titre plus restitution matrice
    Range("G1").Resize(1 + UBound(CodeId), 1).Value = Application.Transpose(CodeId)
    Application.ScreenUpdating = True
End Sub

Voir si la vitesse pour 50k lignes est suffisante.

 

[KH94]

Re,
un essai en PJ avec :

Sub Colle_Code_ID()
    Application.ScreenUpdating = False
    T = Range("A2:F" & Range("A65500").End(xlUp).Row)   ' Transfert Base dans Array
    ReDim CodeId(UBound(T))                             ' Array Code_ID même taille que Base
    With Sheets("Transco")                              ' Transfert Transco dans Array
        Transco = .Range("A2:D" & .Range("A65500").End(xlUp).Row)
    End With
    For i = 1 To UBound(T)
        Civil = T(i, 1): Ville = T(i, 5): CAF = T(i, 6)
        For j = 1 To UBound(Transco)                ' Séparer les 3 IF accélère le process
            If Transco(j, 3) = CAF Then             ' si CAF ok
                If Transco(j, 2) = Ville Then       ' et Ville ok
                    If Transco(j, 1) = Civil Then   ' et civilité ok
                        CodeId(i) = Transco(j, 4)   ' alors on récupère le Code_ID
                        Exit For                    ' on a trouvé, donc on sort
                    End If
                End If
            End If
        Next j
    Next i
    CodeId(0) = "Code_ID"                           ' Titre plus restitution matrice
    Range("G1").Resize(1 + UBound(CodeId), 1).Value = Application.Transpose(CodeId)
    Application.ScreenUpdating = True
End Sub

Voir si la vitesse pour 50k lignes est suffisante.

Je ne sais pas comment vous remercier

Vous venez de reduire mes nuit blanches de 90%

Merci infiniment.

 

[sylvanu]

Il en reste encore 10% !

 

[KH94]

Petite demande supplementaire, est-ce possible de faire appel à la feuille de transco meme si cette derniere est dans un autre classeur? (10% restant )

 

[sylvanu]

Oui, mais pas avec la même macro.
Elle sera dans le même dossier ?

 

[KH94]

Oui, mais pas avec la même macro.
Elle sera dans le même dossier ?

Oui oui, normalement j'effectue deux operations avant d'avoir la base de données finale. une fusion de plusieurs bases et une extraction des colonnes specifiques ( j'ai deja la solution pour ces deux)

ensuite l'etape de la transco. donc le tableau de la transco est aussi dans le meme dossier que la base de données mais pas dans le meme classeur

 

[sylvanu]

Je regarde, mais c'est un peu plus compliqué.

 

[mapomme]

Bonjour à tous,

==> première question
Une autre manière avec la structure "Dictionary". C'est assez rapide pour 50 000 lignes de données (0,75 sec.).

Sub Rechercher_Code_id()
Dim tId As New Dictionary, t, i As Long, clef, debut
   debut = Timer
 
   'si filtre actif, on affiche tout pour que .CurrentRegion fonctionne correctement
   If Sheets("Transco").FilterMode Then Sheets("Transco").ShowAllData
   'lecture du tableau TRANSCO
   t = Intersect(Sheets("Transco").Range("a1").CurrentRegion, Sheets("Transco").Range("a:d"))
   'remplissage du dico correspondant à Transco (clef = Civilité\Ville\Aides et Item = )
   For i = UBound(t) To 2 Step -1: tId(Join(Array(t(i, 1), t(i, 2), t(i, 3)), "\")) = t(i, 4): Next i
 
   'si filtre actif, on affiche tout pour que .CurrentRegion fonctionne correctement
   If Sheets("base").FilterMode Then Sheets("base").ShowAllData
   'lecture  BASE dans le tableau t
   t = Intersect(Sheets("Base").Range("a1").CurrentRegion, Sheets("Base").Range("a:g"))
 
   'remplissage direct de la colonne Code_id par l'intermédiaire du dictionary tId
   For i = 2 To UBound(t)
      clef = Join(Array(t(i, 1), t(i, 5), t(i, 6)), "\")    'calcul de la clef
      'si la clef existe, on affecte le Code_id du dictionary correspond à la clef dans le tableau T (7 ème colonne)
      If tId.Exists(clef) Then t(i, 7) = tId(clef)
   Next i
 
   'réécriture de t sur la Base
   Sheets("base").Range("a1").Resize(UBound(t), 7) = t
   MsgBox Format(Timer - debut, "0.00\ sec.")
End Sub

 

[sylvanu]

Bonjour MaPomme,
Sous Win10 et XL2007, j'obtiens :

Vous pouvez tester ?

 

[sylvanu]

Re,
@KH, un essai en PJ.
Les deux PJ doivent être dans le même dossier.
J'ai rajouté :

    ' Ouverture fichier liste Code_Id, récupération liste codes, fermeture fichier
    Fichier = ThisWorkbook.Path & "\Liste_Code_ID.xlsx"  ' Nom à modifier si nécessaire.
    Workbooks.Open Fichier
    With Sheets("Transco")                              ' Transfert Transco dans Array
        Transco = .Range("A2:D" & .Range("A65500").End(xlUp).Row)
    End With
    ActiveWindow.Close
    '-----------------

 

[mapomme]

Re,

Pour la 2ème question,

• Les deux fichiers sont dans le dossier de fichier Base
• Le code dans le fichier Base comprend en tête de code deux constantes qui sont respectivement le nom du fichier Tranco et le nom de la feuille contenant le tableau des références.

mettre les deux fichiers dans le même dossier.

 

[KH94]

Merci à vous deux pour une solution très ingénieuse.

@sylvanu je crois que la proposition de @mapomme met plus de temps car il a incrémenter les ligne du coup dans sa base on a finalement 50 k lignes.

Cependant @mapomme, est possible de mettre en rouge les ligne qui n'ont pas été transcodées dans la base de données? histoire de de ne pas fouiller dans toute la base....

Je sais que je demande de trop