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
| Sub inverse()
Dim Dcel As Long, Dcol As Long, Dic As Object, c, Dpt As Range
Dcel = Range("A2").End(xlDown).Row 'Dernière cellule non vide dans le tableau, non dans la feuille
Dcol = Range("A2").End(xlToRight).Column 'Dernière colonne non vide dans le tableau, non dans la feuille
ReDim TbF(1 To (Dcel - 1) * (Dcol - 1), 1 To Dcel - 1) ' je dimensionne la variable pour la remplir plus bas
Titre = Range("A2", Cells(2, Dcol)) 'servira si annulation
TbG = Range("A3", Cells(Dcel, Dcol)) 'tableau alimenté par la plage d'origine (sans les titres)
a = 0
Set Dic = CreateObject("Scripting.Dictionary") 'je déclare un dico
For i = 2 To UBound(TbG, 2) 'je boucle sur le tableau (2ème dimension)
For j = 1 To UBound(TbG, 1) 'je boucle sur le tableau (1ère dimension)
a = a + 1
TbF(a, 1) = TbG(j, i) 'j'alimente la 1ère dimension du tableau qui servira de résultat
If TbF(a, 1) <> "" Then Dic(TbF(a, 1)) = "" 'et mon dico qui élimine les doublons et les vides
Next j
Next i
ReDim TbF(1 To Dic.Count, 1 To Dcel) '2ème tableau redimensionné pour prendre les valeurs du dico
a = 1
For Each c In Dic 'une boucle qui prend les valeurs
TbF(a, 1) = c
a = a + 1
Next c
tri (TbF) 'j'atteins la procédure de tri
For i = 1 To UBound(TbF, 1) 'je boucle pour organiser les données
boucle TbF(i, 1)
Next i
'ci -dessous, c'est du brodage pour choisir la destination du résultat
On Error Resume Next
Set Dpt = Application.InputBox("à partir de quelle cellule" & Chr(10) & "souhaitez-vous le résultat", "VOTRE ATENTION !", Type:=8)
If Not Dpt Is Nothing Then
If Dpt <> "" Then Dpt.CurrentRegion.Clear 'on vide la région de la cellule choisie
Dpt.Resize(UBound(TbF, 1), UBound(TbF, 2)) = TbF 'pour intégrer le résultat
End If
Error.Goto 0
End Sub |
Partager