Discussion :

[luckyalan]

Patrick, je reviens sur un même point que celui évoqué avec rdurupt,
il faudrait que je trie sans doublons mais en ignorant la casse, sur le titre et aussi sur l'artiste.
après j'écris le titre comme il est dans la première occurrence, mais juste pour le tri, que je me retrouve pas avec 2 artistes pour Jean jacques goldman et jean Jacques Goldman, et idem pour je te donne + Je te donne + JE TE DONNE... ETC...
c'est au niveau de if not dico.exist que ca se joue, j'ai essayé de l'écrire ce matin mais je plante.
merci

[Invité]

Bonjour,
personnellement j'ai pas vue de problème sur le nombre de titre impaire, en ce qui concerne la case sur les tire affiché j'a corrigé le problème!

je vais te fournir un version commenté qui te permettra de mieux appréhender le code.

en attentant test ça! je comprend le coté déroutant des module de classe et je ne t'en voudrais pas si tu renonçais à ma version, mais en terme d'apprentissage, je t'invite à analyser le code!

[patricktoulon]

ok
donc si je comprend bien il y a la possibilité que dans la liste de base il y ai des doublons (majuscule/minucule) mais avec le meme orthographe c'est bien ca ?
dans ce cas la c'est encore une fois tout simple
tu l'a un peu compris d'ailleurs c'est bien au moment qe entrer dans le dico que cela se joue
le principe on ne peut plus simple c'est de mettre en vbpropercase les noms des chanteurs tout simplement

sans vouloir aller contre le sens de rdurupt
voila la simple sub a peine modifiée

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
Sub test_4_colonne()
    Sheets(2).Range("A1:F" & Rows.Count).Clear
    Dim tablo, dicochanson, lig, NBSONG, a, elem, tablochanson
    Set dicochanson = CreateObject("Scripting.Dictionary")
    tablo = Sheets(1).Range("A1:A" & Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row)
    For i = 1 To UBound(tablo)
        chanteur = StrConv(Split(tablo(i, 1), "£")(0), vbProperCase)
        If Not dicochanson.exists(chanteur) Then dicochanson(chanteur) = ""
        If Not dicochanson(chanteur) Like "*" & Split(tablo(i, 1), "£")(1) & "*" Then dicochanson(chanteur) = dicochanson(chanteur) & " | " & Split(tablo(i, 1), "£")(1)
    Next
    nextlettre = ""
    For Each elem In dicochanson
        With Sheets(2)
            lig = .UsedRange.SpecialCells(xlCellTypeLastCell).Row + 2
            .Cells(lig, 2) = elem
            If Left(elem, 1) <> nextlettre Then
                With .Cells(lig, 1): .Value = Left(elem, 1): .Font.Bold = True: .Interior.Color = vbGreen: End With
                nextlettre = Left(elem, 1)
            End If
            NBSONG = Split(dicochanson(elem), " | ")
            With .Cells(lig, 2): .Interior.ColorIndex = 46: .Font.Bold = True: End With
            ReDim tablochanson(200, 2)
            For a = 1 To UBound(NBSONG)
                place = False
                For tlig = 0 To UBound(tablochanson)
                    For tcol = 0 To 1
                        If tablochanson(tlig, tcol) = "" Then tablochanson(tlig, tcol) = NBSONG(a): place = True: Exit For
                    Next
                    If place = True Then Exit For
                Next
            Next
            .Cells(lig, 3).Resize(200, 2) = tablochanson
            .Columns("A:D").AutoFit
        End With
        Debug.Print elem & "::" & dicochanson(elem)
    Next
End Sub

tout simplement
et en plus ils seront tout en nom propre (c'est plus propre sans jeu de mot)

Explication:
tout ce passe dans cette boucle

Code :

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

1
2
3
4
5
6
7
For i = 1 To UBound(tablo)
        chanteur = StrConv(Split(tablo(i, 1), "£")(0), vbProperCase)
       
        If Not dicochanson.exists(chanteur) Then dicochanson(chanteur) = ""
       
 If Not dicochanson(chanteur) Like "*" & Split(tablo(i, 1), "£")(1) & "*" Then dicochanson(chanteur) = dicochanson(chanteur) & " | " & Split(tablo(i, 1), "£")(1)
    Next

la ligne rouge met la premiere partie avant le "£" (split("....)(0) ca tu l'a compris en nom propre (majuscule a chaque mot)
ainsi si l'on a un doublon
exemple

Charles Aznavour£Et moi dans mon coin£.kfn [21 MB]

charles aznavour£Et moi dans mon coin£.kfn [21 MB]

on se retrouve dans le dico avec ceci si dessous grace a la ligne bleu

Charles Aznavour

ensuite la ligne orange teste si le split sur £ (1) donc le 2 element de la ligne ( chanson) est presente dans la colonne valeur du dico
si elle n'est pas presente elle l'ajoute séparé par le " | "
et voila on a un dico sans doublons de chanteur ou de chanson

une simple boucle
1 dico avec les clé (chanteur) en vbpropercase
2 la fonction "Like" sur le split(1)(chanson)

on peut aussi faire la meme chose sur les chansons mais la je crois qu'il faut sedemander d'ou provient le listing enfin c'est toi qui vois
pas plus difficile que ca

[luckyalan]

merci à tous les 2.
en fait je ne peux pas adopter un affichage formaté, c'est compliqué car on va retrouver Charles Aznavour (en nom propre ca va) dans la même liste que NTM (là ca va pas) et en titre, on retrouvera par exemple "Il faut savoir" (majuscule première lettre ok) mais aussi "YMCA" ou "Si tu vas à Rio" où on a des majuscules dans le corps de phrase.
Donc je pars du principe qu'on ne reformate pas l'écriture car mes fichiers sont "sensés" être bien nommés, sauf que dans 10.000 fichiers il y a obligatoirement des erreurs (5% ca ferait 500 titres à refaire).
c'est pour ca que dans le tri je suis obligé d'ignorer la casse mais dans l'écriture il faut que je garde la casse d'origine, donc je pars du principe que le premier fichier qui porte le nom a la bonne casse et là si ce n'est pas le cas cela sautera aux yeux et je ferai la correction.
je tiens à vous dire à tous les 2 que votre aide a été appréciée de la même façon, pas de concurrence, mais rdurupt, c'est vrai que mon but premier est d'apprendre et que les codes avec 2 classes sont très complexes pour moi qui ne connaissais même pas l’existence du "dictionary" et le fait que ton code ne gère pas le dernier de liste si la liste est impaire est rédhibitoire, car je ne peux pas me permettre d'omettre des titres. Or il se trouve que je ne suis capable ni de comprendre ni de réparer ces anomalies sur tes codes.
je ne voudrais surtout pas de mes posts puissent être pris pour des critiques car j'apprécie au plus haut point l'aide apportée par quelques uns à la communauté des forumeurs et je ne suis pas du tout dans la critique, juste dans la recherche de "résoudre et comprendre pour savoir refaire moi même

[patricktoulon]

re
bon la j'avoue que je te comprends plus
tu sousentendais qu'il y avais possibilité de doublons (minuscule/majuscule) donc contrairement a ce que tu dis en dernier ton fichier n'est pas bien concus
mais bon c'est pas grave

donc si je comprend bien tu a des chanteurs ecrit comme ceci:

Charles Asnavour
YMCA
ETC.

...
ET DONC AVEC MA DERNIERES VERSIONS TU TE RETROUVERAIS AVEC

Charles Asnavour
Ymca
ETC

mais petit jeadail il y a une solution pour ca encore une fois toute simple
change la boucle du dico pour celle ci:

Code :

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

1
2
3
4
5
6
7
8
9
For i = 1 To UBound(tablo)
        If Split(tablo(i, 1), "£")(0) <> UCase(Split(tablo(i, 1), "£")(0)) Then
            chanteur = StrConv(Split(tablo(i, 1), "£")(0), vbProperCase)
        Else
            chanteur = Split(tablo(i, 1), "£")(0)
        End If
        If Not dicochanson.exists(chanteur) Then dicochanson(chanteur) = ""
        If Not dicochanson(chanteur) Like "*" & Split(tablo(i, 1), "£")(1) & "*" Then dicochanson(chanteur) = dicochanson(chanteur) & " | " & Split(tablo(i, 1), "£")(1)
    Next

conclusion si tu a dans ta base

Charles Asnavour
YMCA
ETC.

ca restera comme tel
t'es dur en affaire toi

et pour les chanson je ne les modifie pas alors pour moi c'est nikel non?

sauf si tu a des doublons chanson (minuscules/majuscules) alors la oui tu sera obligé de formater la chaine

pas plus difficile que ca

[Invité]

je réédite ce que j'ai dit plus haut, tu est le mettre d’œuvre, et tu as le droit et le devoir d'avoir une application qui correspond exactement à tes attente!

il n'est en aucun cas question de sensibilité mais juste te te fournir une réponse qui cadre exactement à ta demande. pas d’approximation mais exactement!

tu peux formuler et du dois formuler toutes les critiques possible pour obtenir l’application digne de tes attentes!

[patricktoulon]

re
en changeant la boucle comme je l'ai dit dans mon post precèdent
résultat
vue de la base
Pièce jointe 189383

vue du résultat
Pièce jointe 189384

[patricktoulon]

je me suis basé sur le fichier de rdurupt pour la liste de base

si c'est bien le tiens en parlant de fichier bien nommé comme tu dis regarde la ligne 322 de la base
y a pas un blème ici

edit:
et j'en releve encore des petit defauts regarde ce qui est en gras et il y en a plein d'autre

Chante Comme si tu devais mourir demain GV+Video
afrique adieu.avi [28 MB]
Je veux l'epouser pour un soir.avi [39 MB]
Je viens du sud.avi [39 MB]

ce qui fait que si tu fait une recherche du titre par leur noms tu le trouvera pas car tu aura des caracteres supperflus dans les noms de chanson
moi je dis ca j'dis rien hein....
j'avais fait la meme chose y a pas mal d'années quand je faisait des anims karaoké je sais de quoi je parle j'avais plus de 15 000 titre en avi,en midi avec liryc,en mpeg,en flash etc....
j'ai toujours mes disque durs d'ailleurs
au pire il faudrait passer au netoyage des titres
exemple
replace(texte,".avi")
ou split(texte,".avi")(0)
etc......

[luckyalan]

je sais bien que ma base de données comprend des erreurs que je me dois de corriger et je m'y emploie.
ce que je voudrais c'est ne pas avoir à résoudre des problèmes qui n'en sont pas, c'est a dire les problèmes de casse sur le titre et sur l'auteur.
pour illustrer ma demande, voici les lignes de code que j'ai fait moi meme et qui répondent à ce problème, mais que je n'arrive pas à adapter au dictionary.

Code :

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

1
2
3
4
5
6
7
8
For i = 1 To Range("G65535").End(xlUp).Row
 
   If UCase(Cells(i + 1, 7)) <> UCase(Cells(i, 7)) Then
   If UCase(Cells(i, 7)) <> UCase(artiste) Then
    Cells(ligne, 1) = Cells(i, 7)
    Cells(ligne, 1).Borders(xlEdgeTop).LineStyle = xlContinuous ' (xlEdgeTop)
    artiste = UCase(Cells(i, 7))
    End If

dans ce lignes je dis que
si dans la ligne à venir la variable artiste Ucase est differente de la cellule artiste de la ligne courante Ucase alors je met la cellule de la ligne courante telle qu'elle est.
donc ce que je voudrais écrire en gros mais que je n'arrive pas à faire c'est (peut-être que je me trompe)
si l'artiste (converti en majuscule) n'est pas présent dans le dictionnaire clé artiste (converti en majuscule) alors nouvelle cle artiste (telle qu'elle est non convertie)
idem pour l'item titre, s'il n'existe pas dejà casse indifférente, je met un nouvel item tel qu'il est lu non converti...
Après pour les erreurs persistante dans mon fichier, j'en ai encore plein et je les corrige au fur et à mesure, et c'est un boulot de fou car je les modifie dans le nom de fichier pour ne pas répéter le problème à la prochaine mise à jour de mon catalogue.
NB : je ne fais pas que me reposer sur vous, j'ai déjà adapté (avec de l'aide) une macro qui marche et résoud 100% de mon problème, mais elle travaille cellule par cellule et met 15 minutes à chaque traitement.
si je persiste avec vous c'est que grace à vous je peux apprendre le fonctionnement du dictionary que vous m'avez fait découvrir...
Surtout, si je vous ennuie, il vous suffit de ne pas répondre et je comprendrai et ne posterai plus sur ce sujet
pour info mon code complet qui marche sans dictionaire

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
40
41
42
43
44
45
46
47
48
49
50
51
52
Sub Bouton1_Clic()
Application.ScreenUpdating = False
'trier les données
Columns("G:G").Select
Selection.Sort Key1:=Range("G1")
 
' convertir les données de la colonne G
For i = 1 To Range("G65535").End(xlUp).Row
For j = 1 To Len(Cells(i, 7))
    If Mid(Cells(i, 7), j, 1) = "£" Then
        Cells(i, 8) = Mid(Cells(i, 7), j + 1, 999)
        Cells(i, 7) = Left(Cells(i, 7), j - 1)
    End If
    For k = 1 To Len(Cells(i, 8))
        If Mid(Cells(i, 8), k, 1) = "£" Then Cells(i, 8) = Left(Cells(i, 8), k - 1)
    Next k
Next j
Next i
'----------------------
'suppression des doublons
For i = 1 To Range("G65535").End(xlUp).Row
While UCase(Cells(i + 1, 7).Value) = UCase(Cells(i, 7).Value) And UCase(Cells(i + 1, 8).Value) = UCase(Cells(i, 8).Value) And (Cells(i + 1, 7).Value) <> ""
Rows(i).Delete
'Cells(i, 1).EntireRow.Delete
Wend
Next i
artiste = "aucun"
' répartition des données en colonne A et B
ligne = 1
For i = 1 To Range("G65535").End(xlUp).Row
 
   If UCase(Cells(i + 1, 7)) <> UCase(Cells(i, 7)) Then
   If UCase(Cells(i, 7)) <> UCase(artiste) Then
    Cells(ligne, 1) = Cells(i, 7)
    Cells(ligne, 1).Borders(xlEdgeTop).LineStyle = xlContinuous ' (xlEdgeTop)
    artiste = UCase(Cells(i, 7))
    End If
Cells(ligne, 2) = Cells(i, 8)
Else
If UCase(Cells(i, 7)) <> UCase(artiste) Then
    Cells(ligne, 1) = Cells(i, 7)
    Cells(ligne, 1).Borders(xlEdgeTop).LineStyle = xlContinuous
    artiste = UCase(Cells(i, 7))
    End If
Cells(ligne, 2) = Cells(i, 8)
Cells(ligne, 3) = Cells(i + 1, 8)
i = i + 1
End If
ligne = ligne + 1
Next i
Application.ScreenUpdating = True
End Sub

merci

[luckyalan]

rdurupt, je viens de tester ton nouveau code, le bug du titre impair est réparé et apparemment tout est bon.
je vais arrêter pour ce soir je reviendrai voir ton code documenté si tu me l'envoie, mais c'est vrai que les 2 classes ca me perturbe. j'avoue que j'aurai préféré 1 seule sub et tout dedans, MAIS EN TOUT CAS TON FICHIER ET TA MACRO MARCHENT BIEN

[patricktoulon]

tout est dans cette phrase

mais elle travaille cellule par cellule et met 15 minutes à chaque traitement

c'est bien pour cela que l'on te propose de travailler avec des variables (tableaux/dictionnaires)

j'ai testé ma derniere version on a un résultat parfait en moins de 2 secondes
alors que dire ? sinon LOL

je comprend tres bien qu'etant débutant il y a des choses qui t'échappe mais essaie de travailler plutot avec des variables tableaux plutot que des boucles a n'en plus finir sur tes cellules et les chaines de caracteres
c'est la base

pour les caracteres supperflus (".avi","gv...",etc...) 2 ou 3 lignes de code supplementaire a mettre c'est tout

tu constatera aussi que ta methode pour ne pas changer les nom en ucase est celle que j'utilise mais dans une variable tableau

et le code en est que plus simple et rapide

[luckyalan]

Merci Patricktoulon
Merci rdurupt
effectivement vos 2 programmes répondent à ma problématique.
je vous remercie tous les 2 pour votre patience et votre dévouement à aider les débutants difficiles comme moi.
j'espère que ce sujet servira à d'autres que moi et valorisera d'avantage l'excellent boulot que vous avez fourni
Cordialement

[Invité]

Bonjour,
Dans la vie de tout le jour, on s’intéresse aux pourquoi nous foisonnons tel ou tel action « j’ai faim donc je mange » ! Pas du comment, l’action de mangé est implicite dans notre inconscient.
En programmation on s’interroge sur le comme on exécute une action mais pas du pourquoi ! on boucle sur les actions à mené et ce tant qu’il reste du traitement a effectuer !

Les module de classe permettent une modélisation des actions a mener, l’action de mangé est analysé, décortiqué, modélisé ! La modélisation consiste à définir le comment ! ensuit l’action de manger s’appui sur la modélisation, il n’est plus question de comprendre le déroulement d’une action mais juste de l’exécuter !

Dans notre application catalogue, nous découpons notre traitement en trois actions, l’action alphabétique :

C

H

Ici nous modélisons le comportement de chaque artiste en le positionnant dans l’espace de chaque lettre A, B, C etc.
La modélisation pour chaque artiste :

C	Chanteurs sans Frontieres
	Charles Aznavour
	Charles Trenet
	Charlie & Lulu
	Charts
	Chimene Badi & Michel Sardou
	Chimene Badi
	Christophe
	Christophe Mae
H	hantal Goya

Chaque lettre de l’alphabet reçoit le nom de l’artiste que commence par la lettre concerné !
La modélisation des titres :

C	Chanteurs sans Frontieres	Ethiopie
	Charles Aznavour	Dans le feu de mon ame	Et moi dans mon coin
		Le temps	Les enfants de la guerre
		les Images de ma vie
	Charles Trenet	Coin de rue	Dans les pharmacies
		debit de lait debit de l'eau	Il pleut dans ma chambre
		La mer	Mes jeunes annees
		Revoir Paris
	Charlie & Lulu	Ho hisse	Le feu ca brule
		Les Marseillais
	Charts	Aime moi encore	je menvole
	Chimene Badi & Michel Sardou	Le chant des hommes
	Chimene Badi	Comme un appel
	Christophe	Les marionnettes
	Christophe Mae	C'est ma terre
H	hantal Goya	Voulez vous danser grand mere

Chaque artiste reçoi la liste des titres liés au chanteur !
Nous établissons un hiérarchie entre la lettre de l’alphabet l’artiste et le titre !

C

Chanteurs sans Frontieres

Ethiopie

Ici nous allons définir une hiérarchie alphanumérique (1,23,… ;A,B,C…). Chaque lettre fait référence à un module de classe (Classe2)

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Set Alphabet = CreateObject("Scripting.Dictionary")
For l = 0 To 9
     Set LL = New Classe2
     LL.Lettre = CStr(l)
     Alphabet.Add CStr(l), LL
     Set LL = Nothing
Next
 
For l = 0 To 25
     Set LL = New Classe2
     LL.Lettre = Chr(65 + l)
     Alphabet.Add Chr(65 + l), LL
     Set LL = Nothing
Next

Code Classe2 :

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
 
Public Lettre As String
Public DicoArtiste As Object
Public titre
Public Artste As String
Dim nb As Integer
Dim Dico
Dim Alphabet As Object
Public cl As Classe1
 
Private Sub Class_Initialize()
Set DicoArtiste = CreateObject("Scripting.Dictionary")
End Sub
Public Sub Ecrire(Feuille As Worksheet)
Dim derL As Long
derL = Feuille.Range("A1").CurrentRegion.Rows.Count + 1
If DicoArtiste.Count > 0 Then
Feuille.Cells(derL, "a") = Lettre
Feuille.Cells(derL, "a").Font.Bold = True
Feuille.Cells(derL, "a").Font.Underline = xlUnderlineStyleSingle
Feuille.Cells(derL, "A").Font.Size = 16
Feuille.Cells(derL, "A").Interior.ColorIndex = 16
 i = DicoArtiste.items
    For l = 0 To DicoArtiste.Count - 1
      i(l).Ecrire Feuille
    Next
 End If
End Sub

Chaque artiste fait référence et à un lettre (A,B,C) et à un lettre d’artiste commençant par cette lettre !

C	Chanteurs sans Frontieres

Class1 :

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
Public titre
Public Artste As String
Dim nb As Integer
Dim Dico
 
Private Sub Class_Initialize()
Set Dico = CreateObject("Scripting.Dictionary")
ReDim titre(nb)
End Sub
Public Sub Ajouter(T As String)
v = Split(T, "£")
 If Dico.Exists(v(1)) = False Then
    Dico.Add v(1), v(1)
    ReDim Preserve titre(nb)
    Artste = Trim("" & v(0))
    titre(nb) = v(1)
    nb = nb + 1
    End If
End Sub
 
Public Sub Ecrire(Feuille As Worksheet)
Dim derL As Long
derL = Feuille.Range("A1").CurrentRegion.Rows.Count
If Trim("" & Feuille.Cells(derL, "c")) <> "" Then derL = derL + 1
Feuille.Cells(derL, "B") = Artste
Feuille.Cells(derL, "B").Font.Bold = True
Feuille.Cells(derL, "B").Font.Underline = xlUnderlineStyleSingle
Feuille.Cells(derL, "B").Interior.ColorIndex = 45
Feuille.Cells(derL, "B").Font.Size = 12
c = 0
For i = 1 To UBound(titre) + 1
    Feuille.Cells(derL, "C").Offset(0, c) = titre(i - 1)
    If i Mod 2 = 0 Then derL = derL + 1: c = -1
    c = c + 1
Next
End Sub

Fait référence à un artiste et aux titres de ses chansons !

Alain Bashung

Hier a Sousse

Les mots bleus

En fait l’idée est de modéliser la gestion du catalogue ! chaque module de classe sais ce qu’il doit faire ajout d’une lettre (112131A,B,C) Set Alphabet = CreateObject("Scripting.Dictionary").
Artiste :

Code :

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

1
2
3
4
5
6
 Public DicoArtiste As Object Private Sub Class_Initialize()
Set DicoArtiste = CreateObject("Scripting.Dictionary")
Private Sub Class_Initialize()
Set Dico = CreateObject("Scripting.Dictionary")
ReDim titre(nb)
End Sub

Deroulement :

Code Module1 :

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
40
41
 
Dim R As Range, cl As Classe1, Alphabet As Object, LL As Classe2
Set Alphabet = CreateObject("Scripting.Dictionary")
'initialisaton de la colection Lettre (1,2,3,A,B,C)
For l = 0 To 9
     Set LL = New Classe2
     LL.Lettre = CStr(l)
     Alphabet.Add CStr(l), LL
     Set LL = Nothing
Next
 
For l = 0 To 25
     Set LL = New Classe2
     LL.Lettre = Chr(65 + l)
     Alphabet.Add Chr(65 + l), LL
     Set LL = Nothing
Next
'///////////////////////////////////////////////////////
Dim DicoArtiste As Object
 Set DicoArtiste = CreateObject("Scripting.Dictionary")
Set R = ThisWorkbook.Sheets("Feuil1").UsedRange
Set Dico = CreateObject("Scripting.Dictionary")
For l = 1 To R.Rows.Count
     If Dico.Exists(UCase(Split(R(l, 1), ".")(0))) = False Then 'si Claude Francois£meme si tu revenais existe
        Dico.Add UCase(Split(R(l, 1), ".")(0)), UCase(Split(R(l, 1), ".")(0))
        If Alphabet(UCase(Left(Trim(R(l, 1)), 1))).DicoArtiste.Exists(UCase(Split(R(l, 1), "£")(0))) = False Then '[C]->Claude Francois
            Set cl = New Classe1
            Alphabet(UCase(Left(Trim(R(l, 1)), 1))).DicoArtiste.Add UCase(Split(R(l, 1), "£")(0)), cl
            Set cl = Nothing
        End If
        Alphabet(UCase(Left(Trim(R(l, 1)), 1))).DicoArtiste(UCase(Split(R(l, 1), "£")(0))).Ajouter R(l, 1) '[C]->[Claude Francois]->meme si tu revenais
     End If
Next
i2 = Alphabet.items
For l = 0 To Alphabet.Count - 1
i2(l).Ecrire ThisWorkbook.Sheets("Feuil2") '[C]->[Claude Francois]->[meme si tu revenais]
Next
ThisWorkbook.Sheets("Feuil2").Cells.ColumnWidth = 48.71
ThisWorkbook.Sheets("Feuil2").Cells.EntireRow.AutoFit
ThisWorkbook.Sheets("Feuil2").Cells.EntireColumn.AutoFit
End Sub

Code Classe1 :

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
 Public titre
Public Artste As String
Dim nb As Integer
Dim Dico
 
Private Sub Class_Initialize()
Set Dico = CreateObject("Scripting.Dictionary")
ReDim titre(nb)
End Sub
Public Sub Ajouter(T As String)
v = Split(T, "£")
 If Dico.Exists(v(1)) = False Then
    Dico.Add v(1), v(1)
    ReDim Preserve titre(nb)
    Artste = Trim("" & v(0))
    titre(nb) = v(1)
    nb = nb + 1
    End If
End Sub
 
Public Sub Ecrire(Feuille As Worksheet)
Dim derL As Long
derL = Feuille.Range("A1").CurrentRegion.Rows.Count
If Trim("" & Feuille.Cells(derL, "c")) <> "" Then derL = derL + 1
Feuille.Cells(derL, "B") = Artste '[C]-> [Claude Francois]
Feuille.Cells(derL, "B").Font.Bold = True
Feuille.Cells(derL, "B").Font.Underline = xlUnderlineStyleSingle
Feuille.Cells(derL, "B").Interior.ColorIndex = 45
Feuille.Cells(derL, "B").Font.Size = 12
C = 0
For i = 1 To UBound(titre) + 1
    Feuille.Cells(derL, "C").Offset(0, C) = titre(i - 1) '[C]-> [Claude Francois]->[meme si tu revenais]
    If i Mod 2 = 0 Then derL = derL + 1: C = -1
    C = C + 1
Next
End Sub

Code Classe2 :

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
 Public Lettre As String
Public DicoArtiste As Object
Public titre
Public Artste As String
Dim nb As Integer
Dim Dico
Dim Alphabet As Object
Public cl As Classe1
 
Private Sub Class_Initialize()
Set DicoArtiste = CreateObject("Scripting.Dictionary")
End Sub
Public Sub Ecrire(Feuille As Worksheet) 'Ecrir Lettre (1,2,3,A,B,C)
Dim derL As Long
derL = Feuille.Range("A1").CurrentRegion.Rows.Count + 1
If DicoArtiste.Count > 0 Then
Feuille.Cells(derL, "a") = Lettre
Feuille.Cells(derL, "a").Font.Bold = True
Feuille.Cells(derL, "a").Font.Underline = xlUnderlineStyleSingle
Feuille.Cells(derL, "A").Font.Size = 16
Feuille.Cells(derL, "A").Interior.ColorIndex = 16
 i = DicoArtiste.items
    For l = 0 To DicoArtiste.Count - 1
      i(l).Ecrire Feuille '[C]-> [Claude Francois]->[meme si tu revenais]
    Next
 End If
End Sub

[luckyalan]

merci rdurupt pour ces explications