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 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78
| Const DATAOBJECT_BINDING As String = "new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}"
Public Property Let PressePapier(value)
With CreateObject(DATAOBJECT_BINDING)
.SetText value
.PutInClipboard
End With
End Property
Public Property Get PressePapier()
With CreateObject(DATAOBJECT_BINDING)
.GetFromClipboard
PressePapier = .GetText
End With
End Property
Sub test()
Dim Artiste As Object, Plage As Range
Set Plage = ThisWorkbook.Sheets("Compositeurs").Range("A1").CurrentRegion
Set Artiste = CreateObject("Scripting.Dictionary")
For i = 2 To Plage.Rows.Count
If Not Artiste.exists(Plage(i, 1).value) Then Artiste.Add Plage(i, 1).value, New Compositeur: Artiste(Plage(i, 1).value).Nom = Plage(i, 1).value
Next
For i = 2 To Plage.Rows.Count
If CStr("" & Plage(i, 2).value) <> "" Then
If Not Artiste(Plage(i, 1).value).Eleve.exists(Plage(i, 2).value) Then Artiste(Plage(i, 1).value).Eleve.Add Plage(i, 2).value, Artiste(Plage(i, 2).value)
If Not Artiste(Plage(i, 2).value).Maitre.exists(Plage(i, 1).value) Then Artiste(Plage(i, 2).value).Maitre.Add Plage(i, 1).value, Artiste(Plage(i, 1).value)
End If
Next
Dim txt As String, t: txt = ""
k = Artiste.Keys
For i = 0 To Artiste.Count - 1
t = Artiste(k(i)).Eleves & vbCrLf
t = Split(t, "Maitre->" & vbTab)
a = ""
If UBound(t) = 1 Then
a = "Maitre->" & vbTab
End If
t = Artiste(k(i)).Eleves & vbCrLf
t = Replace(t, a, "")
txt = txt & t
Next
While CBool(InStr(txt, "Maitre->" & vbTab & "Maitre->" & vbTab))
txt = Replace(txt, "Maitre->" & vbTab & "Maitre->" & vbTab, "Maitre->" & vbTab)
Wend
While CBool(InStr(txt, "Élève->" & vbTab & "Maitre->" & vbTab))
txt = Replace(txt, "Élève->" & vbTab & "Maitre->" & vbTab, "Eleve->" & vbTab)
Wend
'Eleve-> Maitre->
ThisWorkbook.Sheets("Arbre").UsedRange.Clear
PressePapier = txt
ThisWorkbook.Sheets("Arbre").Range("A1").PasteSpecial xlPasteAll
ThisWorkbook.Sheets("Arbre").Select
Couple Artiste
k = Artiste.Keys
For i = 0 To Artiste.Count - 1
Debug.Print Artiste(k(i)).CoupleCount
Next
End Sub
Sub Couple(ByRef Artiste As Object)
Dim R As Range: Set R = ThisWorkbook.Sheets("Couple").UsedRange
For i = 2 To R.Rows.Count
If Artiste.exists(R(i, 1).value) And Artiste.exists(R(i, 2).value) Then
Artiste(R(i, 1).value).Couple(R(i, 2).value) = Artiste(R(i, 2).value)
Artiste(R(i, 2).value).Couple(R(i, 1).value) = Artiste(R(i, 1).value)
End If
Next
End Sub |