Traitement dans une variable tableau

Bonjour,

J'aurai beaucoup de fichiers comportant plusieurs milliers de lignes à traiter dans un avenir proche.

J'ai réalisé des macros qui effectuent le traitement en quelques minutes, mais sur le principe je ne suis pas satisfait et je souhaiterais passer par des variables tableau pour faire quelque chose de propre et de beaucoup plus rapide.

Actuellement je récupère bien l'intégralité des données dans la variable tableau, mais le traitement qui supprime les lignes en doublon (repérées en colonne A sur le champ CD_NOM) se fait toujours directement sur la feuille. Je ne vois pas trop comment faire pour effectuer ce traitement dans la variable tableau et coller ce tableau sur la feuille une fois le traitement terminé.

Je joins le fichier en ne laissant que quelques lignes pour l'exemple.

La macro concernée est "Sub Concatène_viaArray_et_colleFeuille2()"

La partie qu'il faudrait faire traiter par une variable tableau commence ici : For NoLigTr = 1 To DerLig

En vous remerciant par avance pour votre aide.

Dan

Bonjour,

Un peu de lecture pour commencer.

Voir Tutoriel : Comment combiner (fusionner) des fichiers Excel avec Power Query (vidéo YouTube).

On verra après pour supprimer les doublons (en 2 clics).

http://www.lecfomasque.com/power-query-combiner-plusieurs-fichiers-excel/

A te relire.

Cdlt.

Bonjour,

En complément de la réponse de Jean-Eric, si PowerQuery ne t'inspire pas, je te livre ma réflexion vers une piste différente.

Sur ce coup, je ne suis pas persuadé que ta variable Tablo soit suffisante :

Bien sur il faudra passer par une variable Tablo pour charger toutes tes lignes.

Ensuite au lieu de passer en revue la feuille ligne par ligne et colonne par colonne, tu vas passer en revue tout ton Tablo ligne par ligne et colonne par colonne... (Gain de temps / 20) et faire tes concat dans la 1ère ligne.

Enfin quand tous tes remplacement sont terminés tu va verser ton Tablo dans un Dictionnary : C'est très rapide et ça va dédoublonner ton Tablo : Le Dictionnary ignore les doublons d'index et est encore plus rapide que les Arrays...

Quand cette opération est terminée YAPUKA tranvaser ton Dictionnary dans ta feuille cible (c'est instantané)

Le Hic, c'est que moi je t'ai théorisé la chose, mais le pro des Dictionnary, c'est mon ami Ferrand et Ferrand, en ce moment, il joue les coquettes... Donc il va surement falloir que tu fasses ton initiation tout seul...

Là encore un peu de lecture :

Tout sur les Dictionnary ici

Bon courage !

A+

Re,

Bonjour galopin01,

Power Query, l'objet Dictionary

Aïe!..., cela fait beaucoup à la fois.

Cdlt.

Bonsoir à tous,

En fait, tu veux garder les uniques

Option Explicit
Sub test()
Dim a, i As Long, e, dico As Object
    Set dico = CreateObject("Scripting.Dictionary")
    a = Sheets("Travail").Range("a1").CurrentRegion.Value
    For i = 2 To UBound(a, 1)
        If Not dico.exists(a(i, 1)) Then
            dico(a(i, 1)) = Application.Index(a, i, 0)
        Else
            dico(a(i, 1)) = Empty
        End If
    Next
    For Each e In dico.keys
        If IsEmpty(dico(e)) Then dico.Remove e
    Next
    a = Application.Index(dico.items, 0, 0)
    Sheets("Feuil1").Range("a1").Resize(UBound(a, 1), UBound(a, 2)).Value = a
    Set dico = Nothing
End Sub

klin89

Bonsoir,

Merci pour vos propositions.

Les 2 premières me semblent compliquées et longues à comprendre et à mettre en place (vu mon niveau), en sachant qu'actuellement ce que j'ai fait fonctionne (lentement), mais ne me satisfait pas au sens de la programmation.

La 3ème proposition ne correspond pas à la demande, mais c'est de ma faute, car j'ai du mal à expliquer ce que je cherche à faire.

En fait il faut conserver les uniques, mais aussi conserver les doublons en concaténant les lignes en double avec les données comprises dans ces 2 lignes.

Il doit rester 54 lignes de données après traitement.

Je pense que la 3ème proposition pourrait être adaptable.

En tout cas, merci beaucoup pour vos propositions.

Dan

Bonjour,

Compte tenu de tes informations, ton fichier en retour...

Réalisé avec Récupérer et transformer (Power Query) en 20 secondes.

Le résultat est-il satisfaisant?

Cdlt.

Re Dan67100,

A tester :

Option Explicit
Sub test()
Dim a, i As Long, j As Long, n As Long, dico As Object
    Set dico = CreateObject("Scripting.Dictionary")
    dico.CompareMode = 1
    a = Sheets("Travail").Range("a1").CurrentRegion.Value
    For i = 2 To UBound(a, 1)
        If Not dico.exists(a(i, 1)) Then
            n = n + 1: dico(a(i, 1)) = n
            For j = 1 To UBound(a, 2)
                Set a(n, j) = CreateObject("Scripting.Dictionary")
                a(n, j).CompareMode = 1
                a(n, j)(a(i, j)) = Empty
            Next
        Else
            For j = 1 To UBound(a, 2)
                a(dico(a(i, 1)), j)(a(i, j)) = Empty
            Next
        End If
    Next
    For i = 1 To n
        For j = 1 To UBound(a, 2)
            a(i, j) = Join$(a(i, j).keys, vbLf)
        Next
    Next
    Application.ScreenUpdating = False
    With Sheets("Feuil1").Range("a1")
        .CurrentRegion.Cells.Clear
        With .Resize(n, UBound(a, 2))
            .Value = a
            With .Font
                .Name = "calibri"
                .Size = 10
            End With
            .Columns.AutoFit
            .Rows.AutoFit
            .VerticalAlignment = xlTop
            .Borders.Weight = 2
        End With
        .Parent.Activate
    End With
    Set dico = Nothing
    Application.ScreenUpdating = True
End Sub

klin89

Bonjour,

Merci beaucoup pour ce travail.

Je n'ai pas eu le temps de tout vérifier, mais ça semble fonctionner.

Il subsiste malgré tout un problème qui me semble anormal :

en passant par votre procédure la durée est de 271 secondes pour 18.000 lignes alors qu'en travaillant directement sur la feuille originale (avec le code initial), la durée n'est que de 72 secondes.

En théorie, ça devrait être le contraire.

Si vous avez une idée ?

Bonne journée et encore merci pour le temps passé à m'aider.

Dan

re Dan67100,

On va commencer par épurer tes données figurant en feuille "Travail"

Sub nettoyage()
    With Sheets("Travail").UsedRange
        .Value = Evaluate("if(row(" & .Address & "),clean(trim(" & .Address & ")))")
    End With
End Sub

Puis teste le code avec une liaison anticipée, cela devrait être plus rapide

Sub test()
'n'oublie pas d'ajouter la référence à "Microsoft Scripting Runtime"
Dim a, i As Long, j As Long, n As Long
Dim dico As Scripting.Dictionary
    Set dico = New Scripting.Dictionary
    dico.CompareMode = 1
    a = Sheets("Travail").Range("a1").CurrentRegion.Value2
    For i = 2 To UBound(a, 1)
        If Not dico.exists(a(i, 1)) Then
            n = n + 1: dico(a(i, 1)) = n
            For j = 1 To UBound(a, 2)
                Set a(n, j) = New Scripting.Dictionary
                'Set a(n, j) = CreateObject("Scripting.Dictionary")
                a(n, j).CompareMode = 1
                a(n, j)(a(i, j)) = Empty
            Next
        Else
            For j = 1 To UBound(a, 2)
                a(dico(a(i, 1)), j)(a(i, j)) = Empty
            Next
        End If
    Next
    For i = 1 To n
        For j = 1 To UBound(a, 2)
            a(i, j) = Join$(a(i, j).keys, vbLf)
        Next
    Next
    Application.ScreenUpdating = False
    With Sheets("Feuil1").Range("a1")
        .CurrentRegion.Cells.Clear
        With .Resize(n, UBound(a, 2))
            .Value = a
            With .Font
                .Name = "calibri"
                .Size = 10
            End With
            .Columns.AutoFit
            .Rows.AutoFit
            .VerticalAlignment = xlTop
            .Borders.Weight = 2
        End With
        .Parent.Activate
    End With
    Set dico = Nothing
    Application.ScreenUpdating = True
End Sub

klin89

Bonjour,

Merci encore pour ton travail.

Toujours pas mieux : 321 secondes alors que ça en prend 72 en travaillant directement sur la feuille.

Quelque chose ne fonctionne pas comme ça devrait, mais quoi ?

Bonne soirée et merci encore

Dan