Aide macro

Bonjour à tous,

je vous expliquer ma problématique ca fait plusieurs heures que je cherche mais ne trouve pas de solutions... la recherchev fait planter mon PC

J'ai un fichier A dans lequel j'ai les informations de mes clients... email etc...

et j'ai plusieurs fichiers 1,2,3,4,5 dans lequel j'ai le scoring de ces clients et j'ai une valeur commune aux 2 fichiers qui est l'emai

je souhaiterai ajouter dynamiquement le scoring de mes clients présents dans les fichiers 1 2 3 4 5 qui comprennent plus de 500 000 lignes chacun dans une nouvelle colonne de mon fichier A qui comprend plus de 500 000 lignes

ci joint un exemple

Merci merci bcp pour votre aide

111.xlsx (9.57 Ko)
11a.xlsx (10.01 Ko)

Bonsoir

Macro pour aller chercher des informations similaires dans 2 fichiers séparés

Merci

Bonjour,

tu mets ce fichiers et tes fichiers 1 à 5 (et uniquements ceux-là) dans un répertoire dédié.

Cliquer sur MAJ

Sub score()
    Dim datas, datas2, result, dict
    Dim lig As Long, ano As Long, ano2 As Long
    Dim chemin As String, Fichier As String
    Dim wb As Workbook, wb2 As Workbook
    Set dict = CreateObject("Scripting.Dictionary")

    datas = [A2].Resize(Cells(Rows.Count, 1).End(xlUp).Row - 1).Value
    ReDim result(1 To UBound(datas), 1 To 1)
    ' email dans dictionary
    For lig = 1 To UBound(datas)
        If datas(lig, 1) <> "" Then dict(datas(lig, 1)) = lig
    Next lig

    Set wb = ThisWorkbook
    chemin = wb.Path + "\"
    Fichier = Dir(chemin & "*.xl*")    ' 1er fichier
    Application.ScreenUpdating = False
    Do While (Len(Fichier) > 0)
        If Fichier <> ThisWorkbook.Name Then
            Set wb = Workbooks.Open(chemin & Fichier)
            ' traitement
            ' !!! la feuille avec données doit être la 1ère !!!
            With wb.Worksheets(1)
            datas2 = .[A2].Resize(.Cells(Rows.Count, 1).End(xlUp).Row - 1, 2).Value
            End With
            wb.Close
            For lig = 1 To UBound(datas2)
                If datas2(lig, 1) <> "" And datas2(lig, 2) <> "" Then
                    If dict.exists(datas2(lig, 1)) Then
                        If result(dict(datas2(lig, 1)), 1) <> "" Then ano2 = ano2 + 1
                        result(dict(datas2(lig, 1)), 1) = datas2(lig, 2)
                    Else
                        ano = ano + 1
                    End If
                End If
            Next lig
        End If
        Fichier = Dir()    ' fichier suivant
    Loop
    [R2].Resize(UBound(result)) = result
    MsgBox "Emails non trouvés dans " & ThisWorkbook.Name & " : " & ano & vbLf _
                            & "Doublons emails : " & ano2
End Sub

Doublons email signifie qu'un mail avec score a été trouvé plusieurs fois dans les fichiers 1 à 5.

Le dernier score lu est mis.

eric

6a.xlsm (22.49 Ko)

Salut Patgui,

Tu peux expliquer ton dernier message ?!?

Donc, tu as plusieurs fichiers clients de +- 500.000 lignes et un fichier A clients de 500.000 lignes...

Ça nous donne quelques 2-3 millions de lignes pour 500.000 clients ? Mazette, tu ne dois pas prendre souvent des vacances, toi !

Sans rire, ces clients se retrouvent tous dans chaque fichier 1, 2, 3... avec un score? Lequel choisir?

A+

Edit : Salut Eriiic!

Salut Curulis

Merci pour ta réponse

Merci ERIC

Oui comme Eric la dit on peut prendre le dernier scoring trouvé

Ou créer une colonne par fichier de scoring et après on arbitrera

Merci

Ou créer une colonne par fichier de scoring et après on arbitrera

change la 2nde dimension de result et adapte la suite en conséquence.

eric

Je test ça ce soir ou demain et reviens vers vous

Merci bcp en tout cas

Connaissez vous des bonnes formations en ligne en vba ?

Salut curulis

Merci ça marche nikel

A part le fait que quand on met les 5 fichiers en même temps Excel plante

Mais ça va le faire je le fais par un

Merci encore bonne soirée

Il n'y a pas de raison.

Ligne en erreur et Message d'erreur ?

A tout hasard nom du fichier ?

Et peut-être que je ferme un trop vite le fichier.

Descend wb.Close sous Next lig

Si ça ne suffit pas essaie en insérant

        MsgBox "Fichier suivant"

devant

       Fichier = Dir()    ' fichier suivant

tu le laisses digérer 2-3s avant de cliquer

Rechercher des sujets similaires à "aide macro"