Discussion :

[patricktoulon]

oK JE VAIS ESSAYER D EXPLIQUER
Sub test()

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 DECLARATION DE VARIABLE   
 Dim col, v As Long, i As Long, tabstring As String, tabgen, z, t, x

etape 1
on met les index de colonne dans l'array col et on redimentionne tabcol a la dimention de col

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
]col= Array(1, 2,5)    'mettre les index de colonne dans l'array
    ReDim tabcol(UBound(col)) As String

v = 0


maintenant on boucle sur les 3 item de col et avec join on en fait une chaine string avec chaque items séparé par des virgules et on les ajoute dans tabstring
au final tabstring contient tout les cellules de la plage

etape 2

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
For t = 0 To UBound(col)
        tabcol(t) = Join(Application.Transpose(Range(Cells(1, col(t)), Cells(Rows.Count, col(t)).End(xlUp)).Value), ",")
        v = v + 1: tabstring = Replace(tabstring, ",,", "") & "," & tabcol(t)
    Next

etape 3
de cette chaine ( tabstring)on créé un array(tableau 1 dim) ce tableau c'est tabgen et on vide tabstring on va le re remplir après

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

tabgen = Split(tabstring, ","): tabstring = ""

souvient toi au début on créé 3 chaines (tabcol()) correspondant a chaque colonnes donc maintenant on a 3 chaines pour les colonne et un tableau 1 dim (tabgen ) contenant tout les item de la plage on va donc boucler sur tout les items de tabgen et comparer au 3 chaines string avec like et donc x prend la valeur du nombre de colonne ou se trouve l'item pendant la boucle si x=1 alors il est dans une seule colonne alors on le met dans tabstring que l'on a précédemment vider

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
For i = 1 To UBound(tabgen)
        vir = IIf(i > 1, ",", ""): x = 0
        For z = 0 To UBound(col)
        If tabcol(z) Like "*" & tabgen(i) & "*" Then x = x + 1
        Next
        If x < 2 Then tabstring = tabstring & vir & tabgen(i)
    Next i

etape 4

on re split la chaine tabstring qui viens d'être re rempli par les seuls items valides avec la meme variable tabgen ( une sorte de redim)(réutilisations de variables )

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

tabgen = Split(tabstring, ",")

etape 5
et nous voila enfin avec un tableau tagen et donc on redimetionne une cell a la dimetion du tableau sur 1 colonne
cette plage obtenue = le tableau (tabgen

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Cells(1, 6).Resize(UBound(tabgen), 1) = Application.Transpose(tabgen)'adapte la colone de reception 
Debug.Print tabstring
End Sub

voila voila pour l'exemple du post #62

[RyuAutodidacte]

Bonsoir Patrick,
Merci je vais regarder tout cela en détails car je trouve cela fort intéressant
je peux te faire confiance en plus, car je sais que tu es adepte de la manipulation des String$

[patricktoulon]

oh t inquiet j aime aussi faire mumuse avec les tableaux mais on prend pas une masse pour casser une noix

et les string$ c'est plutot recent je dirais depuis les demonstrations de marc avec evaluate sur divers post fonction qui m'arrangeraient bien pour mes html

[RyuAutodidacte]

Oui d'ailleurs ce fameux Evaluate va y passer aussi, mais bon on peut pas être au four et au moulin
donc il va attendre un tout petit peu, mais pas trop longtemsp non plus

[patricktoulon]

j en ai meme une avec regular expression lol

[RyuAutodidacte]

ha ha le fameux regex, je suppose que ceux sont a peu près les mêmes règles en général quelque soit l'environnement : appli ou programmation
Pas aisé à utiliser quand on ne les connait pas.
Moi je m'y suis mis avec InDesign, mais j'en fais pas tous les jours

[Marc-L]

j'aimerai bien voir les 2 autres que tu avais préparé

En fait il y en avait quatre, celui posté étant le plus abouti. (1)

Le premier est juste la conversion du code utilisant le tableau de trois collections via un tableau de dictionnaires,
juste pour le fun car en partant directement avec Dictionary je ne l'aurais jamais codé ainsi !

Les deux autres utilisent soit deux dictionnaires indépendants soit un tableau de deux dictionnaires
avec la combinaison Remove et Transpose, le code posté étant la variante du dernier sans cette combinaison …

Le principe étant toujours le même depuis le post #15 : dédoublonner une colonne avant de l'ajouter au dictionnaire principal !

(1) S'il fallait aussi afficher les doublons en colonne J, seules les lignes de code n°2, 16, 18 et 21 sont modifiées
dans ce cinquième code, une évolution de la variante :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Sub Demo4DvUD()
            Dim DIC(1) As New Dictionary, C&, D&, R&, V
    With Feuil3.UsedRange.Columns
        For Each V In .Item(1).Value
            If V > "" Then DIC(0)(V) = 1
        Next
        For C = 3 To 5 Step 2
            For Each V In .Item(C).Value
                If V > "" Then DIC(1)(V) = ""
            Next
            For Each V In DIC(1)
                DIC(0)(V) = DIC(0)(V) + 1
            Next
                Set DIC(1) = New Dictionary ' ou encore DIC(1).RemoveAll
        Next
            ReDim VA$(1 To DIC(0).Count, 1)
        For Each V In DIC(0)
            If DIC(0)(V) = 1 Then R = R + 1: VA(R, 0) = V Else D = D + 1: VA(D, 1) = V
        Next
            .Cells(1, 9).CurrentRegion.Clear
            .Cells(1, 9).Resize(Application.Max(D, R), 2).Value = VA
    End With
          Erase DIC
End Sub

[RyuAutodidacte]

Hi Marc,
Merci
je vais regarder ton nouveau code.
Je suis aussi, encore en train de bucher sur cette histoire de string, histoire de me familiariser, la logique étant vraiment différente.
d'ailleurs je suis tombé sur un code sympathique (je ne sais pas si je vais l'utiliser), permettant de compter le nombre de mot (si je me rappelle bien) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

NbMots = Ubound(Split(MonString, ",") + 1

C'est pratique et pas besoin de boucle

[Marc-L]

Sixième code, une variante du précédent code dans la gestion du tableau final,
modification des lignes de code n°2, 16, 18 et 21 :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Sub Demo4DvUDv()
            Dim DIC(1) As New Dictionary, C&, D%, R&(-1 To 0)
    With Feuil3.UsedRange.Columns
        For Each V In .Item(1).Value
            If V > "" Then DIC(0)(V) = 1
        Next
        For C = 3 To 5 Step 2
            For Each V In .Item(C).Value
                If V > "" Then DIC(1)(V) = ""
            Next
            For Each V In DIC(1)
                DIC(0)(V) = DIC(0)(V) + 1
            Next
                Set DIC(1) = New Dictionary ' ou encore DIC(1).RemoveAll
        Next
            ReDim VA$(1 To DIC(0).Count, -1 To 0)
        For Each V In DIC(0)
            D = DIC(0)(V) = 1:  R(D) = R(D) + 1:  VA(R(D), D) = V
        Next
            .Cells(1, 9).CurrentRegion.Clear
            .Cells(1, 9).Resize(Application.Max(R), 2).Value = VA
    End With
          Erase DIC
End Sub

[RyuAutodidacte]

Du travail en plus je regarderai tout cela ce soir
Merci

[Marc-L]

Et encore je t'ai évité la version intégrant le compteur du nombre de lignes de chaque colonne
directement dans la variable tableau !

[RyuAutodidacte]

Tant qu'on y est, on est plus à 1 près

[Marc-L]

C'est vrai, quand on aime on ne compte pas !

Toujours les mêmes n° de lignes 2, 16, 18 & 21 modifiées :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Sub Demo4DvUDv2()
            Dim DIC(1) As New Dictionary, C&, D%, R&
    With Feuil3.UsedRange.Columns
        For Each V In .Item(1).Value
            If V > "" Then DIC(0)(V) = 1
        Next
        For C = 3 To 5 Step 2
            For Each V In .Item(C).Value
                If V > "" Then DIC(1)(V) = ""
            Next
            For Each V In DIC(1)
                DIC(0)(V) = DIC(0)(V) + 1
            Next
                Set DIC(1) = New Dictionary ' ou encore DIC(1).RemoveAll
        Next
            R = DIC(0).Count + 1:  ReDim VA(1 To R, -1 To 0)
        For Each V In DIC(0)
            D = DIC(0)(V) = 1:  VA(R, D) = VA(R, D) + 1:  VA(VA(R, D), D) = V
        Next
            .Cells(1, 9).CurrentRegion.Clear
            .Cells(1, 9).Resize(Application.Max(VA(R, -1), VA(R, 0)), 2).Value = VA
    End With
          Erase DIC
End Sub

Ici cela n'a pas grand intérêt mais dans le cas de plusieurs variables tableaux
cela réduit le nombre de variables compteur à gérer …

[RyuAutodidacte]

Hi Marc, Patrick et le forum,

Pour cause de bouclage en ce moment moins de présence, moins de travail d'Excel, mais j'y suis allé petit à petit

Marc : Merci pour toutes tes démos que j'apprécie grandement

Patrick : Merci pour tes explications sur ton code en $tring et en effet la solution n'est pas évident (comme le dit Marc ça ne vaut pas la peine de s'embêter)

Tous :
Mais n’empêche que sur le sujet du post c'est un sacré entrainement et intéressant (pas facile non plus surtout que c'est la 1è fois que je fait un exercice sur le $tring )
J'ai trouvé une solution en partant au départ sur la compréhension de ton code.

J'ai aussi 2 autres idées en tête (non fait pour l'instant) :
- En partant de ma base, sauvegarder dans un string les doublons extra colonnes à supprimer En fait, le Replace et plus efficace (cf Edit + post suivant)
- Utiliser les regex pour supprimer les doublons extra colonnes

Maintenant le code (merci d'être indulgent, mais vu le peu de temps en ce moment, j'ai pas encore optimisé l'écriture de celui-ci) :
PS: Merci d'avance pour tous les commentaires ou améliorations possible apportées

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
Sub MonString_A_Doublons()
Dim col, d$, dd$, S$, TabStrg$
    col = Array(1, 3, 5)
        ReDim Tabcol$(UBound(col))
    For n& = 0 To UBound(col)
        Tabcol(n) = Join(Application.Transpose(Range(Cells(1, col(n)), Cells(Rows.Count, col(n)).End(xlUp)).Value), ","): Tabcol(n) = Replace(Tabcol(n), ",,", ",") & ","
            S = Tabcol(n)
            For Each v In Split(Tabcol(n), ",")
                d = InStr(S, v & ",")
                If dd Like "*" & d & "," & "*" Then
                    Tabcol(n) = Left(Tabcol(n), InStr(1 + InStr(Tabcol(n), v & ","), Tabcol(n), v & ",") - 2) & Right(Tabcol(n), Len(Tabcol(n)) - InStr(1 + InStr(Tabcol(n), v & ","), Tabcol(n), v & ",") + 2 - Len(v) - 1)
                Else
                    dd = dd & "," & InStr(S, v)
                End If
            Next
            dd = "": TabStrg = Replace(TabStrg, ",,", ",") & "," & Tabcol(n)
    Next
 
    TabStrg = Replace(TabStrg, ",,", ","): S = TabStrg
 
    For Each v In Split(TabStrg, ",")
        If InStr(S, v & ",") > 0 And v > "" Then
            d = InStr(TabStrg, v & ",")
            If dd Like "*" & d & "," & "*" And InStr(S, v & ",") > 0 Then
                Do
                    If InStr(S, v & ",") < InStr(1 + InStr(S, v & ","), S, v & ",") Then
                        S = Left(S, InStr(1 + InStr(S, v & ","), S, v & ",") - 2) & Right(S, Len(S) - InStr(1 + InStr(S, v & ","), S, v & ",") + 2 - Len(v) - 1)
                    Else
                        S = Left(S, InStr(S, v & ",") - 2) & Right(S, Len(S) - InStr(S, v & ",") + 2 - Len(v) - 1)
                    End If
                Loop Until InStr(S, v & ",") = 0
            Else
                dd = dd & "," & InStr(TabStrg, v & ",")
            End If
        End If
    Next
    tabgen = Split(Mid(S, 2, Len(S) - 1), ",")
Cells(1, 8).Resize(UBound(tabgen), 1) = Application.Transpose(tabgen)
End Sub

Edit : je vois aussi, pas encore testé, que je pourrais optimiser la 2è partie du code avec un Replace

[RyuAutodidacte]

Bonjour,

PS : Patrick le tabcol(z) Like "*" & tabgen(i) & "*" n'est pas suffisant pour repérer les valeurs car
dans le cas où tu te retrouves par exemple avec TOTO1 (tabgen(i)) tu ne tomberas pas forcément sur la bonne valeur car il peut y avoir en tabgen(i), TOTO10
de même que TOTO2 => TOTO22
Donc le mieux pour avoir la valeur exact c'est (pour ce cas là, mais d'autres situations du même genre pourraient se présenter):

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

tabcol(z) Like "*" & tabgen(i) & "," & "*"

Et si on veut vraiment tout verrouiller pour être sur de n'avoir aucune erreur :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

tabcol(z) Like "*" & "," & tabgen(i) & "," & "*"

Voilà c'est fait, nouvelle modification du code avec Replace
Optimisation plus efficace sur la 2ème partie du code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Sub MonString_A_Doublons_2()
Dim col, d$, dd$, S$, TabStrg$
    col = Array(1, 3, 5)
        ReDim Tabcol$(UBound(col))
    For n& = 0 To UBound(col)
        Tabcol(n) = Join(Application.Transpose(Range(Cells(1, col(n)), Cells(Rows.Count, col(n)).End(xlUp)).Value), ","): Tabcol(n) = Replace(Tabcol(n), ",,", ",") & ","
            S = Tabcol(n)
            For Each v In Split(Tabcol(n), ",")
                d = InStr(S, v & ",")
                If dd Like "*" & d & "," & "*" Then
                    Tabcol(n) = Left(Tabcol(n), InStr(1 + d, Tabcol(n), v & ",") - 2) & Right(Tabcol(n), Len(Tabcol(n)) - InStr(1 + d, Tabcol(n), v & ",") + 2 - Len(v) - 1)
                Else
                    dd = dd & "," & InStr(S, v)
                End If
            Next
            dd = "": TabStrg = Replace(TabStrg, ",,", ",") & "," & Tabcol(n)
    Next
 
    TabStrg = Replace(TabStrg, ",,", ","): S = TabStrg
 
    For Each v In Split(TabStrg, ",")
        If InStr(S, v & ",") > 0 And v > "" Then
            d = InStr(TabStrg, v & ",")
            If dd Like "*" & d & "," & "*" And InStr(S, v & ",") > 0 Then
                S = Replace(S, v & ",", "")
            Else
                dd = dd & "," & InStr(TabStrg, v & ",")
            End If
        End If
    Next
    tabgen = Split(Mid(S, 2, Len(S) - 1), ",")
Cells(1, 8).Resize(UBound(tabgen), 1) = Application.Transpose(tabgen)
End Sub

Edit : je remets le tableau test

TOTO1		TOTO10		TOTO22
TOTO2		TOTO11		TOTO9
TOTO3		TOTO12		TOTO22
TOTO4		TOTO3		TOTO25
TOTO5		TOTO14		TOTO20
TOTO6		TOTO15		TOTO1
TOTO7		TOTO16		TOTO3
TOTO1		TOTO6
TOTO9		TOTO18
		TOTO19
		TOTO20
		TOTO14

Le résultat à obtenir :

TOTO2

TOTO4

TOTO5

TOTO7

TOTO10

TOTO11

TOTO12

TOTO14

TOTO15

TOTO16

TOTO18

TOTO19

TOTO22

TOTO25

[Marc-L]

Salut !

Félicitations car ton code renvoie bien le bon résultat mais tu le sais déjà !

Pour voir s'il y a quelque chose à améliorer il faudrait entrer dans la logique de ce code, je laisse ce loisir à Patrick
car dans le cas d'un gros volume de données à traiter manipuler des chaînes de caractères s'avère bien plus long
que d'utiliser collections ou dictionnaires …

[RyuAutodidacte]

Merci Marc
C'est sur il y a plus pratique (Collection ...)
ce que je trouvais intéressant c'est la façon d'y arriver en utilisant juste la position des noms à n + 1 m'indiquant si des doublons existent
en plus cela pourra resservir dans certains cas selon les données

[patricktoulon]

Bonjour ryu

oui comme marc l'a dit ca reste une dernière alternative quand cela devient trop compliqué en terme de code avec les collection

pour ma part comme marc je préfère quand même les dicos car âpres tout nous avons les outils servons nous en

après pour ta dernière démo qui fonctionne certes mais me rends perplexe

j'e t'ai monter comment en jouant avec des chaine de caractères (en string) on pouvait faire et a chacun de tes retours tu le complique encore plus


ma méthode était très simple

on fait une chaine pour chaque colonne on les join et split pour en faire un tableau1 dim(array)
et tout simplement on boucle sur l'array en testant si il se trouve dans les 3 chaines séparées
point final y a pas aller chercher je ne sais quoi

en fait pour résumer en cherchant a trop analyser mon code tu a perdu de vu ce que je voulais te démontrer

qui était ce que j'ai cité plus haut

sans doute l'enthousiasme du débutant qui obtient un résultat

non la seul amélioration que l'on pourrait apporter a ma démo c'est de supprimer une boucle pour n'en avoir qu'une seul dans le code travaille sur ca plutôt et tu te rendra compte que tes instr et je sais pas trop quoi sont inutile

je te donne un indice

creation du tableau xligne3 colonne (la 1,3,5) je dit bien tableau et non un string
tu peut faire cela avec evaluate comme te la montré marc


ensuite avec join sur l'index(x) de chaque colonne tu créé le string

j'ai retrouver des esquisses de base dans mes archives qui pourront t'aider a comprendre comment joue ton avec les tableaux quand on a pas evaluate


annalyse bien

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Sub tt()
    newarray = Array(100, 200, 300, 400, 500, 600, 700, 800, 900, 1000, 1100, 1200, 1300, 1400, 1500)
    tableau = Range("A1:C15").Value
    MsgBox UBound(tableau, 1)
 
 'Récupérer la colonne 3 dans un tableau a 2 dim
    Vecteur = Application.WorksheetFunction.Index(tableau, 0, 1)
    Debug.Print Vecteur(1, 1)
 
 'Récupérer la ligne 3 dans un tableau a 1 dim (array)
    Vecteur = Application.WorksheetFunction.Index(tableau, 3, 0)
    'Debug.Print Join(Vecteur, ",")
 
    'récupérer une colonne d'un tableau dans un array a 1 dimention
    Vecteur = Application.Transpose(Application.Index(tableau, , 2))
    Debug.Print Join(Vecteur, ",")
 
 'injecter un array  1 dim dans un colonne d'un tableau a 2 dim
    colonne = Application.WorksheetFunction.Index(tableau, 0, 3)
    colonne = Application.Transpose(newarray)
    Debug.Print colonne(1, 1)
    ' Application.WorksheetFunction.Index(tableau, 0, 3) = Application.Transpose(newarray)
    'colonne = Application.Transpose(newarray)
 
 
End Sub

je m'en servait pour gerer le code binnaire de mes images

bien sur il y a aussi redim preseve qui peut te permettre dynamiquement d'ajouter ou d'extraire une colonne ou ligne c'est moins courant mais c'est possible

exemple
tableau=range("A1:c20")
redim preserve (tableau(10,3)
on obtiens plus qu'un tableau de 10 lignes et on fait pareil pour les colonnes

voila encore un peu je charcutage de neurones et pense a redim preserve réfléchi bien

[RyuAutodidacte]

Re,
Merci Patrick pour ton retour,
je vais regarder ton exemple de plus prés.

J'ai essayé de résoudre ton dernier code (String) post #78 avec le problèmedu TOTO25 manquant TOTO9 non supprimé
Mais je n'y suis pas arrivé; c'est d’ailleurs pour cela que je m'y suis pris autrement. (Et aussi par ce que ta démonstration devait se faire en bonne partie avec du String)

après pour ta dernière démo qui fonctionne certes mais me rends perplexe

j'aimerai bien comprendre ce qui te rend perplexe ??

Pour commencer, j'ai pas encore regardé pour voir ce qu'il y avait à optimiser (Sauf le Replace)

Ma logique :
1 - ) J'ai commencé comme toi en créant les 3 items de col - la petite différence , c'est que je me suis attaqué directement au cellules vides et aux doublons dans chaque item de col un peu comme une collection
le seul moyen que j'ai trouvé pour repérer les doublons est en utilisant la position de la valeur voulu avec InStr - si une même valeur plus éloigné dans l'item donne la même position, alors c'est un doublon à supprimer
pour supprimer le doublon proprement j'ai concaténer les valeurs à sa Droite avec les valeurs à sa Gauche
Le S est le miroir de l'item sur qui on va se basé pour vérifier les doublons - ici pas de suppression, on a besoin de vérifier si la position existe - si elle existe on supprime a InStr + 1 dans l'item

2 - ) Maintenant on se retrouve avec le TabStrg (comme toi), PS : étant donné que les doublons sont supprimé pour chaque items de col, si il existe des doublons ce sera forcément dans une autre colonne - sauf que la on travaille seulement avec TabStrg
Donc rebelote, vérification de la position pour chaque valeur à InStr + 1 avec l'aide de S (= TabStrg) - si il y a doublons on utilise le Replace pour tous les supprimer

Voilà

[RyuAutodidacte]

Bonsoir,
J'ai trouvé une petite faille quand dans les 2 dernières cellules, des doublons se suivent même espacés d'une cellule vide.

Je remets le code corrigé :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Sub MonString_A_Doublons2()
Dim col, d$, dd$, S$, TabStrg$
    col = Array(1, 3, 5)
        ReDim Tabcol$(UBound(col))
    For n& = 0 To UBound(col)
        Tabcol(n) = Join(Application.Transpose(Range(Cells(1, col(n)), Cells(Rows.Count, col(n)).End(xlUp)).Value), ","): Tabcol(n) = Replace(Tabcol(n), ",,", ",") & ","
            S = Tabcol(n)
            For Each v In Split(Tabcol(n), ",")
                d = InStr(S, v & ",")
                If dd Like "*" & d & "," & "*" Then
                    Tabcol(n) = Left(Tabcol(n), InStr(1 + InStr(Tabcol(n), v & ","), Tabcol(n), v & ",") - 2) & Right(Tabcol(n), Len(Tabcol(n)) - InStr(1 + InStr(Tabcol(n), v & ","), Tabcol(n), v & ",") + 2 - Len(v) - 1)
                Else
                    dd = dd & InStr(S, v) & ","
                End If
            Next
            dd = "": TabStrg = Replace(TabStrg, ",,", ",") & "," & Tabcol(n)
    Next
 
    TabStrg = Replace(TabStrg, ",,", ","): S = TabStrg
 
    For Each v In Split(TabStrg, ",")
        If InStr(S, v & ",") > 0 And v > "" Then
            d = InStr(TabStrg, v & ",")
            If dd Like "*" & d & "," & "*" And InStr(S, v & ",") > 0 Then
                S = Replace(S, v & ",", "")
            Else
                dd = dd & "," & InStr(TabStrg, v & ",")
            End If
        End If
    Next
    tabgen = Split(Mid(S, 2, Len(S) - 1), ",")
Cells(1, 8).Resize(UBound(tabgen), 1) = Application.Transpose(tabgen)
End Sub