Petite aide pour compiler tableau avec dictionnaire(s)
3 réponses
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 :)
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
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
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
'---------------------------------------------------------------
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
'------------------------------------------------------------------- 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
'-------------------------------------------------------------------
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
'--------------------------------------------------------------
'------------------------------------------------------------------- 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
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
J'ai omis de déclarer la variable "Dim Col As Long".
Si tu veux gagner quelques nanosecondes dans le temps d'exécution...
