Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Petite aide pour compiler tableau avec dictionnaire(s)

3 réponses
Avatar
Patrick
Bonjour,

Un tableau doit est compilé comme indiqué avec une formule mais je tente
de faire ça avec un dictionnaire et ça ne fonctionne pas, j'ai encore
des doublons.
Le résultat escompté doit être pareil au tableau bleu (fait en formule)
mais si bcp de lignes, la méthode des dictionnaires et (tableaux
éventuellement) sera plus rapide.

Merci de votre aide et de commenter le code, afin que je sache ce qui
cloche :)

lien wetransfer:

https://we.tl/qt4Sm49SlY

3 réponses

Avatar
News.aioe.org
Bonjour,
Voici une manière de précéder :
'---------------------------------------------------------------
Sub test()
'La procédure suppose que les données de la colonne A
'ont été triés au préalable comme dans ton exemple
Dim Rg As Range, C As Range
Dim Dest As Range, Ligne As Long
With Worksheets("Feuil1")
'Les données débutent en A2, à adapter au besoin.
Set Rg = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
End With
'Première cellule de la plage où seront copiées les données.
'tu peux choisir la feuille et la cellule de ton choix
Set Dest = Worksheets("Feuil1").Range("N10")
Application.ScreenUpdating = False
Application.EnableEvents = False
Set C = Rg(1)
Do
If C = C.Offset(1) Then
col = col + 1
Dest.Offset(Ligne) = C
Dest.Offset(Ligne, col) = C.Offset(, 1)
Else
col = col + 1
Dest.Offset(Ligne, col) = C.Offset(, 1)
col = 0
Ligne = Ligne + 1
End If
Set C = C.Offset(1)
Loop Until C.Value = ""
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
'---------------------------------------------------------------
MichD
Avatar
News.aioe.org
'-------------------------------------------------------------------
Sub test()
'La procédure suppose que les données de la colonne A
'ont été trié au préalable comme dans ton exemple
Dim D As Object
Dim Rg As Range, C As Range
Dim Dest As Range, Ligne As Long
With Worksheets("Feuil1")
'Les données débutent en A2, à adapter au besoin.
Set Rg = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
End With
'Première cellule de la plage où seront copiées les données.
'tu peux choisir la feuille et la cellule de ton choix
Set Dest = Worksheets("Feuil1").Range("N10")
Application.ScreenUpdating = False
Application.EnableEvents = False
Set C = Rg(1)
Do
'création du dictionnaire
If D Is Nothing Then
Set D = CreateObject("scripting.dictionary")
End If
If C = C.Offset(1) Then
Dest.Offset(Ligne) = C
If Not D.Exists(C.Offset(, 1).Value) Then
col = col + 1
D.Add C.Offset(, 1).Value, col
Dest.Offset(Ligne, col) = C.Offset(, 1)
End If
Else
col = col + 1
If Not D.Exists(C.Offset(, 1).Value) Then
D.Add C.Offset(, 1).Value, col
Dest.Offset(Ligne, col) = C.Offset(, 1)
End If
col = 0
Ligne = Ligne + 1
Set D = Nothing
End If
Set C = C.Offset(1)
Loop Until C.Value = ""
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
'--------------------------------------------------------------
MichD
Avatar
News.aioe.org
J'ai omis de déclarer la variable "Dim Col As Long".
Si tu veux gagner quelques nanosecondes dans le temps d'exécution...
MichD