Discussion:
Petite aide pour compiler tableau avec dictionnaire(s)
Add Reply
Patrick
2017-01-31 10:25:05 UTC
Réponse
Permalink
Raw Message
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
News.aioe.org
2017-01-31 12:09:18 UTC
Réponse
Permalink
Raw Message
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
2017-01-31 13:00:13 UTC
Réponse
Permalink
Raw Message
'-------------------------------------------------------------------
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
2017-01-31 13:57:39 UTC
Réponse
Permalink
Raw Message
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

Loading...