Utilisation de variable tableau

Bonjour,

Je viens de faire une macro qui lit les cellules d'une colonne. Ces cellules contiennent un nombre de données variables mais dont le nombre peut être relativement important (ex : 81 données dans ligne 2). Ces données sont séparées par " ; "

Le principe est de placer chaque donnée dans sur une nouvelle ligne dans une même colonne.

Actuellement ça fonctionne, mais sans passer par une variable tableau, ce qui allonge grandement la durée de traitement (j'aurai des fichiers comportant plusieurs milliers de lignes).

J'ai commencé à sélectionner les données pour les mettre en variable tableau, mais je ne sais pas comment effectuer le traitement pour coller en une fois le résultat de cette variable après traitement sur la feuille "Resultat" dans la colonne A.

Je ne suis sûrement pas très clair !!!

Vos explications sont les bienvenues.

Je joins une version du fichier avec des données limitées à la colonne Y et seulement quelques lignes.

La macro concernée se nomme Recup_Donnees et n'est pas en fonction pour l'instant (puisqu'elle ne fonctionne pas).

La macro qui fonctionne se nomme Remplir_Cellules, mais elle ne passe pas par une variable tableau.

Cdt

Dan

Sub Recup_Donnees()
' Groupe "Nombre d’éléments composant l’observation (Combien?)
' Si la cellule 'typeDenombrement' est renseignée, les 3 colonnes 'I, J, K' doivent l'être aussi.
' Travaille en variable tableau afin d'accélérer le traitement
Dim Tableau As Variant
Dim DernLigne, DerLig, noLig, i, Cpt As Long
Dim DebCol, DerCol, NoCol, PremLg As Integer
Dim Var, TypeDenombrement, denombrementMin, denombrementMax, objetDenombrement, rep, lg As String
Dim ListeEspece As String
Dim NumLigneArv As Long

Dim FDep As Variant
Dim FArv As Variant
Dim dest As Range
Dim Cel As Range
Dim tm() As String
Dim x As Integer
Dim Rng As Range
Dim LastRow As Long

Set FDep = Worksheets("Travail")
Set FArv = Worksheets("Resultat")

LastRow = FDep.UsedRange.Rows.Count
'Const COLDEP = "Y"
Const COLARV = "A"

Set Rng = FDep.Range("Y1:Y" & LastRow)

    DernLigne = Range("A" & Rows.Count).End(xlUp).Row
    PremLg = 1
    DebCol = 25
    DerCol = 25
    Cpt = 0
    'Tableau = Range(ColLettre(DebCol) & "13", ColLettre(DerCol) & DernLigne).Value
    Tableau = Range(Cells(PremLg, DebCol), Cells(DernLigne, DerCol)).Value
    'Tableau = Range(Cells(13, 9), Cells(DernLigne, 13)).Value
    DerLig = UBound(Tableau, 1)
    DerCol = UBound(Tableau, 2)

    For Each Cel In Range(Cells(PremLg, DebCol), Cells(DernLigne, DerCol)) 'Tableau.Cells 'Rng.Cells
    For i = 2 To UBound(Tableau)
        ListeEspece = Tableau(i, 1)
        NumLigneArv = NumLigneArv + 1
        If Range(COLARV & 1) = "" Then
        'If FArv.Range(COLARV & 1 & "," & COLARV & 2) = "" Then
            Set dest = FArv.Range(COLARV & "65536").End(xlUp).Offset(0, 0)
        Else
            Set dest = Range(COLARV & "65536").End(xlUp).Offset(1, 0)
            'Set dest = FArv.Range(COLARV & "65536").End(xlUp).Offset(1, 0)
        End If
        tm = Split(Cel.Value, " ; ", -1) 'définit le tableau des mots
        MsgBox (Cel.Value)
        For x = 0 To UBound(tm) 'boucle 2 sur tous les mots du tableau
            dest.Offset(x, 0) = tm(x) 'place le mot du tableau en le décalant d'une ligne à chaque mot
        Next x
    Next i
    Next Cel

End Sub

Bonjour,

un essai tableau et dictionary.

Dans le cas présent l'utilisation d'un dictionary permet d'obtenir une liste sans doublon "automatiquement".

Sub DeSplit_Colonne()
Dim FDep As Worksheet, FArv As Worksheet, T, TT
Dim dico, i As Long, j As Long
Set FDep = Worksheets("Travail")
Set FArv = Worksheets("Resultat")
Set dico = CreateObject("Scripting.Dictionary")

T = FDep.Range("Y2:Y" & FDep.UsedRange.Rows.Count) ' plage de données dans un tableau
For i = LBound(T, 1) To UBound(T, 1) ' balayage du tableau
    TT = Split(T(i, 1), " ; ")
    For j = LBound(TT, 1) To UBound(TT, 1)
        dico(TT(j)) = "" 'insertion dans le dictionary
    Next
Next
FArv.Range("B1") = FDep.Range("Y1")  ' ligne de titre
FArv.Range("B2").Resize(dico.Count, 1) = Application.Transpose(dico.keys) 'collage du dico feuille resultat

Set dico = Nothing
End Sub

traitement en moins de 1 seconde sur le classeur joint

A+

Bonjour,

Une proposition Power Query !?

Un volontaire pour vérifier les résultats ?

Cdlt.

Après comparaison avec les résultats de Jean-Eric ( que je salue ), la modification du code qui laissait " ;" collé au dernier terme de chaque cellule et rajoutait donc des éléments :

Sub Split_Colonne()
Dim FDep As Worksheet, FArv As Worksheet, T, TT
Dim dico, i As Long, j As Long
Set FDep = Worksheets("Travail")
Set FArv = Worksheets("Resultat")
Set dico = CreateObject("Scripting.Dictionary")

T = FDep.Range("Y2:Y" & FDep.UsedRange.Rows.Count)
For i = LBound(T, 1) To UBound(T, 1)
    If Not IsEmpty(T(i, 1)) Then
        T(i, 1) = Left(T(i, 1), Len(T(i, 1)) - 2)
        TT = Split(T(i, 1), " ; ")
        For j = LBound(TT) To UBound(TT)
            dico(TT(j)) = ""
        Next
    End If
Next
FArv.Range("B1") = FDep.Range("Y1") ' ligne titre
FArv.Range("B2").Resize(dico.Count, 1) = Application.Transpose(dico.keys)

Set dico = Nothing
End Sub

Résultats : 749 espèces contre 748 avec Power Query !?

manque l'espèce "Rana" ligne 248 feuille Travail (120ème "mot").

A+

Bonsoir,

Formidable !

Exactement ce qu'il me fallait.

Je suis toujours impressionné par la qualité de l'aide apportée.

Merci à vous 2 pour ce travail.

Très cordialement

Dan

Re,

La version Power Query corrigée !...

PQ est un peu coquin.

Lorsque l'on splitte une colonne, il calcule un nombre de colonnes à créer.

Et il peut se tromper (apparemment). J'ai donc majoré ce nombre de colonnes.

Cdlt.