Problème VBA. PQ s'abstenir

Bonjour,

J'ai un problème un classeur avec des listes que je suis en train de remanier...

15 feuilles comportant en moyenne 30 000 lignes (entre 5000 et 60 000 ! )

L'histoire est de les transposer sur le modèle joint (de la "source" vers la feuille "Attendu" (le résultat espéré.)

J'ai une toute petite macro, mais qui n'est pas trop efficace. Je ne la donne pas pour l'instant pour ne pas trop orienter votre recherche.

Je suis en train de me dire que j'aurai du passer par des dictionnary... Quel idiot je fais ! Je viens de passer 3 jours à ferrailler avec mes Arrays alors qu'un Dico par paquets de doublons m'aurait suffit...

Ce qui m'agace le plus ce sont les exceptions déjà présentes dans les colonnes C ou D... comme elles ne sont pas très nombreuses je devrait peut être les déplacer vers la colonne 100 pour ne travailler au départ que sur les colonnes 1 et 2 et quand ce sera fini YORAPUKA les rapatrier ?

L'ordre des items dans les colonnes B à M (voire plus si nécessaire !) n'est pas très important.

Comment vous voyez la chose ?

Merci.

17probleme.xlsm (11.05 Ko)

Bonsoir,

Alors si c'est sans PQ !

Une proposition pour une feuille, avec résultat sur une feuille vierge "LRD" :

Sub LRD_Scan()
    Dim TabS, TabR, VilC, VilT, Cr, Lr, Ir
    TabS = Sheets(1).UsedRange ' données sources
    ReDim TabR(1 To UBound(TabS), 1 To 2) ' on dimensionne le tableau résultat avec le nombre de lignes de la source et 2 colonnes
    Lr = 1 ' numéro de ligne tableau résultat
    Cr = 2 ' numéro colonne tableau résultat
    Ir = 1 ' index max du tableau résultat
    For i = 2 To UBound(TabS)
        VilT = TabS(i, 1) ' on met en mémoire la ville que l'on teste
        ' si la ville testée est différente de la ville "en cours" alors on incrémente la ligne du tableau résultat
        ' on met en colonne 1 la valeur de la ville
        ' nouvelle ligne donc on reprend à la colonne 2 du tableau résultat
        ' la ville en cours est égale à la ville testée
        If VilT <> VilC Then Lr = Lr + 1: TabR(Lr, 1) = VilT: Cr = 2: VilC = VilT
        ' on boucle à minima sur le nombre de colonne de la source en partant de la colonne 2
        For j = 2 To UBound(TabS, 2)
            ' s'il y a une donnée
            If TabS(i, j) <> "" Then
                ' le tableau résultat en ligne en cours et colonne en cours est égale à cette valeur
                TabR(Lr, Cr) = TabS(i, j)
                ' la donnée suivante sera une colonne plus loin
                Cr = Cr + 1
                ' si la colonne plus loin est supérieur à la taille en colonne du tableau résultat
                ' alors on l'agrandi de 1 donc avec la valeur Cr
                ' Ir prend donc cette nouvelle valeur
                If Cr > Ir Then ReDim Preserve TabR(1 To UBound(TabS), 1 To Cr): Ir = Cr
            End If
        Next j
    Next i
    ' on inscrit le résultat sur la feuille nouvelle
    Sheets("LRD").Range("A1").Resize(UBound(TabR), UBound(TabR, 2)) = TabR
End Sub

Ne gère pas les doublons. Reste les entêtes à mettre en place...
Le fichier :

16probleme-lrd.xlsm (20.57 Ko)

@ bientôt

LouReeD

Bonjour,

Impressionnant ! J'avais quelques appréhension quand j'ai vu le Redim Préserve en boucle mais finalement c'est plus rapide que je ne pensais. Voila qui va me faire gagner quelques jours...

Merci

A+

Bonjour,

Merci pour votre retour et remerciement !

Le UBound(TabS) étant utilisé plusieurs fois et en boucle il devrait avantageusement être remplacé par une variable.

La boucle du "j" peut être raccourci s'il n'y a pas de trou de données dans la ligne des Rang :

If TabS(i,j) <> "" then

...

Else

Exit for

End if

Des petits rien qui mis bout à bout permettent de gagner un peu de temps.

@ bientôt

LouReeD

"UBound(TabS) étant utilisé plusieurs fois et en boucle il devrait avantageusement être remplacé par une variable."
Exact : Selon mes anciennes notes le gain est évalué à +2.7* (source http://fordom.free.fr)

A+

Bonjour galopin01, LouReeD,

Galopin01 ayant évoqué le "dictionary", j'ai fait une petite version avec un dictionnaire. L'avantage est que les données sources ne doivent pas être forcément triées.

Pour mes test, j'ai fait une petite procédure Init qui initialise des données ( environ 30 000 villes, environ 360 000 noms (tous différents) et 60 000 lignes de données sources.

Pour le dictionary, j'ai utilisé une méthode qui pour chaque ville (la clef) construit un item qui est la concaténation de la ville et des noms de cette ville séparés par des points-virgules. Les items sont transférés dans la première colonne sur la feuille résultat. On effectue ensuite l'équivalent d'un "convertir" pour distribuer la première colonne dans les cellules. Ca prend environ un peu plus de 2 s sur ma bécane.


nota : pour une ville donnée, on a éliminé les doublons de noms. Cependant si on veut garder les doublons, il suffit d'effacer l’instruction
If InStr(elem, t(i, j)) = 0 Then

Le code est dans module1.

Bonsoir à vous deux !

mafraise, c'est beaucoup mieux !

J'ai encore du chemin pour arriver à ceci !

@ bientôt

LouReeD

Bonsoir,

Oui, j'avais bien réalisé (un peu trop tard) que le Dictionnary était la solution mais la solution de Lou étant déjà,très rapide j'ai pu terminer mon travail également très rapidement.
Bel effort de tous deux. Ça m'a bien avancé car je n'avais plus guère envie de ferrailler avec tous ces noms... D'autant que le reste à faire est tout aussi considérable !

Bonne soirée.

Rechercher des sujets similaires à "probleme vba abstenir"