Petite aide pour compiler tableau avec dictionnaire(s)

Le
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
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
News.aioe.org
Le #26424919
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
News.aioe.org
Le #26424924
'-------------------------------------------------------------------
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
News.aioe.org
Le #26424927
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
Publicité
Poster une réponse
Anonyme