[VBA] Passage d'un Array 1 Colonne en Array "x" Col séparateur "@"

Bonsoir,

Via une macro je croise deux sources de données, qui ont un identifiant en commun.

Je me retrouve avec 1 base de données, chargée dans une variable tableau à 1 colonne.

En effet, ma macro s'exécute pour des bases de données dont les versions varient et où le nombre de colonne change. Pour palier à ce problème j'ai bouclé sur le nombre de colonnes et j'ai tout regroupé dans une seule colonne avec un séparateur "@".

Ces données peuvent être collées dans un onglet, en séparant simplement les colonnes grâces aux "@".

Est-ce qu'il est possible de faire la même chose directement dans une nouvelle variable tableaux dont le nombre de colonnes est calculé d'après le nombre d' "@" par exemple ?

Pour le moment, je sais séparer les données sur une feuille et remplir un nouvel array à partir de cette feuille. Mais j'essaie de trouver une solution plus directe et rapide.

Je joins un fichier Excel où est disponible une des listes en question. Je ne suis pas certain que ce vous soit très utile.

Je vous remercie de votre attention !

Bonne fin de journée

Hello la mouche

Oui tu peux le faire, je ferai comme ceci :

1 - Compte le nombre @ dans chaque ligne de ton tableau (Si toujours le même nombre alors juste tester sur la premiere ligne du tableau)

2 - redimensionne array final

3 - Split chaque ligne de ton tableau par @ dans un array tempo

3 - Affecte les valeur de array tempo en boucle dans array final

R@G

Bonsoir,

un code en proposition, qui se rapproche des explications ci dessus de Rag02700 à la différence du comptage des "@" je crois :

Sub Test_LRD()
    Dim Tablo(), LeTablo(), Temp, I, K, NbLigne, Taille
    Tablo = ActiveSheet.UsedRange.Value
    NbLigne = UBound(Tablo)
    ReDim LeTablo(1 To NbLigne, 1 To 1)
    Taille = 0
    For I = 1 To UBound(Tablo)
        Temp = Split(Tablo(I, 1), "@")
        If UBound(Temp) > Taille Then Taille = UBound(Temp)
        ReDim Preserve LeTablo(1 To NbLigne, 1 To Taille)
        For K = 1 To UBound(Temp)
            LeTablo(I, K) = Temp(K)
        Next K
    Next I
    Feuil2.Range("A1").Resize(UBound(LeTablo, 1), UBound(LeTablo, 2)) = LeTablo
End Sub

En fait on met en tableau le UsedRange
On compte le nombre de ligne du tableau ainsi créé
On dimensionne le tableau final avec ce nombre de ligne et une seule colonne
On boucle sur ce tableau
On split avec le "@"
On regarde si la taille de ce tableau issu du split a une taille plus grande que la taille en mémoire : si oui alors la taille prendre cette valeur sinon rien
On peut donc redimensionner le tableau final au niveau de sa deuxième dimension afin qu'il soit assez grand pour récupérer le nombre maximum de colonne san spour autant connaître ce nombre
On rempli la première ligne du tableau de sortie avec les données en colonne du tableau issu du split
Sur la feuille 2 on inscrit le tableau de sortie

@ bientôt

LouReeD

Bonsoir,

Merci pour vos réponse !

J'ai adapté un peu le code de LouReeD, car il n'avait pas la macro qui précède, ce qui donne ça :

Private Sub temporaire()
Dim lrfo&, lrsa&, lrtab&, lcfo%, lcsa%, sz&, i%, a%, y%, n&, aa As Variant, bb As Variant, tab1(), dict1 As Object, dict2 As Object, _
Temp() As String
Set dict1 = CreateObject("scripting.dictionary"): Set dict2 = CreateObject("scripting.dictionary")

Call Set_Feuilles: Call dcl_fo: Call dcl_sa

With Sheets("FORMULAIRE")
lcfo = .UsedRange.Columns.Count
    For i = lcfo To 1 Step -1
        If .Cells(1, i) Like "*utilisation*" Then .Columns(i).Delete
    Next i
lrfo = .Cells(.Rows.Count, 1).End(xlUp).Row: lcfo = .Cells(1, .Columns.Count).End(xlToLeft).Column
aa = .Range(.Cells(1, 1), .Cells(lrfo, lcfo))
    For i = LBound(aa) To UBound(aa)
        For a = 2 To lcfo
            aa(i, 1) = aa(i, 1) & "@" & aa(i, a)
        Next a
        dict1(aa(i, uni)) = aa(i, 1)
    Next i
End With

With Sheets("SAISIE")
lrsa = .Cells(.Rows.Count, 1).End(xlUp).Row: lcsa = .Cells(1, .Columns.Count).End(xlToLeft).Column
bb = .Range(.Cells(1, 1), .Cells(lrsa, lcsa)): y = 1: n = 0

    For i = LBound(bb) To UBound(bb)
            For a = 2 To lcsa
            On Error GoTo 2
                bb(i, 1) = bb(i, 1) & "@" & bb(i, a): GoTo 1
2               bb(i, 1) = bb(i, 1) & "@" & "Erreur"
1            Next a
        If i = 1 Then dict2(bb(i, pri)) = bb(i, 1)
        If i > 1 Then
            If bb(i, pri) = bb(i - 1, pri) Then n = n + 1 Else n = 0
                dict2(bb(i, pri) & "_" & n) = bb(i, 1)
        End If
    Next i

ReDim tab1(1 To lrsa, 1 To 1): n = 0
    For i = LBound(bb) To UBound(bb)
        If i = 1 Then tab1(i, 1) = dict1("uniquerowid") & "@" & dict2("parentrowid"): GoTo 3
        If i > 1 Then
            If bb(i, pri) = bb(i - 1, pri) Then n = n + 1 Else n = 0
                If dict1.exists(bb(i, pri)) Then
                    If dict2.exists(bb(i, pri) & "_" & n) Then tab1(i, 1) = dict1(bb(i, pri)) & "@" & dict2(bb(i, pri) & "_" & n)
                End If
        End If
3    Next i
End With

'La partie proposée par LouReed : 
lrtab = UBound(tab1): sz = 0: ReDim tab2(1 To lrtab, 1 To 1)
    For i = 1 To lrtab
        Temp = Split(tab1(i, 1), "@")
            If UBound(Temp) > 0 Then
                sz = UBound(Temp)
                    ReDim Preserve tab2(1 To lrtab, 1 To sz)
                    For a = 1 To sz
                        tab2(i, a) = Temp(a)
                    Next a
            End If
    Next i
 End Sub

Maintenant j'ai tab2 que je peux conserver en public et peut-être ne jamais charger...

Merci pour votre aide !

Bonne soirée