aide pour modifier un code [RESOLU]

moutchec

XLDnaute Occasionnel
bonjour le forum,
bonjour à tous,
j'ai besoin d'aide pour modifier ce code qu'on m'a gentiment passé sur ce site il y a quelques temps et que j'utilisais sans problème jusqu'à aujourd'hui.
je me suis rendu compte ce matin que le code produit 201021 n'était pas repris sur la feuille données alors qu'il existe sur la feuille entrées.
en fait le code va sur la "feuille entrées" - copie tout ce qui est en colonne I - fait un tri du plus grand au plus petit - supprime les doublons - et copie sur la "feuille données" en colonne I en laissant une cellule vide à chaque fois.
merci d’avance.
cordialement.
Moutchec.
 

Fichiers joints

Robert

XLDnaute Barbatruc
Bonjour Moutchec, bonjour le forum,

Ton code était écrit pour que les données commencent à la ligne 3 et dans ton exemple elles commencent à la ligne 2 ?!... C'est peut être pour ça... Je l'ai adapté et ça semble fonctionner. Ça devrait même aller plus vite :

VB:
Sub Macro1()
Dim E As Worksheet 'déclare la variable E (Onglet Entrée)
Dim D As Worksheet 'déclare la variable D (Onglet Données)
Dim DL As Long 'déclare la variable DL (Dernière Ligne)
Dim TV As Variant 'déclare la variable TV (Tableau des valeurs)
Dim Dico As Object 'déclare la variable Dico (Dictionnaire)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
Dim I As Long 'déclare la variable I (Incrément)


Set E = Worksheets("ENTREES") 'définit l'onglet E
Set D = Worksheets("DONNEES") 'définit l'onglet D
Set Dico = CreateObject("Scripting.Dictionary") 'définit le dictionnaire Dico
DL = E.Cells(Application.Rows.Count, "I").Row 'définit la dernière ligne éditée DL de la colonne I de l'onglet E
TV = E.Range("I1:I" & DL) 'définit le tableau des valeurs TV
For I = 2 To DL 'boucle sur toutes les lignes I du tableau des valeurs (en partant de la seconde)
  Dico(TV(I, 1)) = "" 'alimente le dictionnaire Dico avec les données de la colonne 1 du tableau des valeurs TV (=> colonne I)
Next I 'prochaine ligne de la boucle
TMP = Dico.Keys 'récupère dans le tableau temporaire TMP la liste du dictionnaire Dico sans doublon
DL = D.Cells(Application.Rows.Count, "I").Row 'définit la dernière ligne éditée DL de la colonne I de l'onglet D
D.Range("I2:I" & DL).Clear 'efface d'éventuelles anciennes données
D.Range("I2").Resize(UBound(TMP) + 1, 1).Value = Application.Transpose(Dico.Keys) 'renvoie la liste sans doublon à partir de I2
D.Range("I1:I" & UBound(TMP) + 1).Sort Key1:=DON.Range("I3"), Header:=xlYes 'tri
lig = D.Range("I" & Rows.Count).End(xlUp).Row 'définit la dernière ligne éditée lig de la colonne I de l'onglet D
For I = 3 To lig * 2
  Sheets("DONNEES").Range("I" & I).Insert (xlDown)
  I = I + 1
Next I
Application.ScreenUpdating = True
End Sub
 

moutchec

XLDnaute Occasionnel
bonjour @Robert et merci pour ton intervention.
il y a un bug (se met en jaune) sur la ligne : D.Range("I1:I" & UBound(TMP) + 1).Sort Key1:=DON.Range("I3"), Header:=xlYes 'tri
merci bcp.
Moutchec
 

Robert

XLDnaute Barbatruc
Re,

En effet, un DON qui traînait... Le nouveau code :

VB:
Private Sub CommandButton1_Click()
Dim E As Worksheet 'déclare la variable E (Onglet Entrée)
Dim D As Worksheet 'déclare la variable D (Onglet Données)
Dim DL As Long 'déclare la variable DL (Dernière Ligne)
Dim TV As Variant 'déclare la variable TV (Tableau des valeurs)
Dim Dico As Object 'déclare la variable Dico (Dictionnaire)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
Dim I As Long 'déclare la variable I (Incrément)


Set E = Worksheets("ENTREES") 'définit l'onglet E
Set D = Me 'définit l'onglet D
Set Dico = CreateObject("Scripting.Dictionary") 'définit le dictionnaire Dico
DL = E.Cells(Application.Rows.Count, "I").Row 'définit la dernière ligne éditée DL de la colonne I de l'onglet E
TV = E.Range("I1:I" & DL) 'définit le tableau des valeurs TV
For I = 2 To DL 'boucle sur toutes les lignes I du tableau des valeurs (en partant de la seconde)
  Dico(TV(I, 1)) = "" 'alimente le dictionnaire Dico avec les données de la colonne 1 du tableau des valeurs TV (=> colonne I)
Next I 'prochaine ligne de la boucle
TMP = Dico.Keys 'récupère dans le tableau temporaire TMP la liste du dictionnaire Dico sans doublon
DL = D.Cells(Application.Rows.Count, "I").Row 'définit la dernière ligne éditée DL de la colonne I de l'onglet D
D.Range("I2:I" & DL).Clear 'efface d'éventuelles anciennes données
D.Range("I2").Resize(UBound(TMP) + 1, 1).Value = Application.Transpose(Dico.Keys) 'renvoie la liste sans doublon à partir de I2
D.Range("I1:I" & UBound(TMP) + 1).Sort Key1:=D.Range("I3"), Header:=xlYes 'tri
lig = D.Range("I" & Rows.Count).End(xlUp).Row 'définit la dernière ligne éditée lig de la colonne I de l'onglet D
For I = 3 To lig * 2
  Sheets("DONNEES").Range("I" & I).Insert (xlDown)
  I = I + 1
Next I
Application.ScreenUpdating = True
End Sub
 

moutchec

XLDnaute Occasionnel
re,
ça fonctionne nickel, merci d'y avoir consacré votre temps.
mes sincères remerciements.
bien à vous.
Moutchec.
 

moutchec

XLDnaute Occasionnel
Re,

En effet, un DON qui traînait... Le nouveau code :

VB:
Private Sub CommandButton1_Click()
Dim E As Worksheet 'déclare la variable E (Onglet Entrée)
Dim D As Worksheet 'déclare la variable D (Onglet Données)
Dim DL As Long 'déclare la variable DL (Dernière Ligne)
Dim TV As Variant 'déclare la variable TV (Tableau des valeurs)
Dim Dico As Object 'déclare la variable Dico (Dictionnaire)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
Dim I As Long 'déclare la variable I (Incrément)


Set E = Worksheets("ENTREES") 'définit l'onglet E
Set D = Me 'définit l'onglet D
Set Dico = CreateObject("Scripting.Dictionary") 'définit le dictionnaire Dico
DL = E.Cells(Application.Rows.Count, "I").Row 'définit la dernière ligne éditée DL de la colonne I de l'onglet E
TV = E.Range("I1:I" & DL) 'définit le tableau des valeurs TV
For I = 2 To DL 'boucle sur toutes les lignes I du tableau des valeurs (en partant de la seconde)
  Dico(TV(I, 1)) = "" 'alimente le dictionnaire Dico avec les données de la colonne 1 du tableau des valeurs TV (=> colonne I)
Next I 'prochaine ligne de la boucle
TMP = Dico.Keys 'récupère dans le tableau temporaire TMP la liste du dictionnaire Dico sans doublon
DL = D.Cells(Application.Rows.Count, "I").Row 'définit la dernière ligne éditée DL de la colonne I de l'onglet D
D.Range("I2:I" & DL).Clear 'efface d'éventuelles anciennes données
D.Range("I2").Resize(UBound(TMP) + 1, 1).Value = Application.Transpose(Dico.Keys) 'renvoie la liste sans doublon à partir de I2
D.Range("I1:I" & UBound(TMP) + 1).Sort Key1:=D.Range("I3"), Header:=xlYes 'tri
lig = D.Range("I" & Rows.Count).End(xlUp).Row 'définit la dernière ligne éditée lig de la colonne I de l'onglet D
For I = 3 To lig * 2
  Sheets("DONNEES").Range("I" & I).Insert (xlDown)
  I = I + 1
Next I
Application.ScreenUpdating = True
End Sub

RE,
bonsoir, qu'est ce qu'il faut modifier dans ce code pour commencer la copie par la ligne 3 de la feuille DONNEES au lieu de la ligne 2.
merci d'avance.
Moutchec.
 

Robert

XLDnaute Barbatruc
Re,

Une autre méthode, peut-être un peu plus rapide :

VB:
Private Sub CommandButton1_Click()
Dim E As Worksheet 'déclare la variable E (Onglet Entrée)
Dim D As Worksheet 'déclare la variable D (Onglet Données)
Dim Dico As Object 'déclare la variable Dico (Dictionnaire)
Dim DL As Long 'déclare la variable DL (Dernière Ligne)
Dim TV As Variant 'déclare la variable TV (Tableau des valeurs)
Dim I As Long 'déclare la variable I (Incrément)
Dim J As Long 'déclare la variable J (incrément)
Dim L As Long 'déclare la variable L (incrément)
Dim TMP1 As Variant 'déclare la variable TMP1 (tableau TeMPoraire 1)
Dim TMP2 As Variant 'déclare la variable TMP2 (tableau TeMPoraire 2)

deb = Timer
Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set E = Worksheets("ENTREES") 'définit l'onglet E
Set D = Me 'définit l'onglet D
Set Dico = CreateObject("Scripting.Dictionary") 'définit le dictionnaire Dico
DL = E.Cells(Application.Rows.Count, "I").Row 'définit la dernière ligne éditée DL de la colonne I de l'onglet E
TV = E.Range("I1:I" & DL) 'définit le tableau des valeurs TV
For I = 2 To DL 'boucle sur toutes les lignes I du tableau des valeurs (en partant de la seconde)
  Dico(TV(I, 1)) = "" 'alimente le dictionnaire Dico avec les données de la colonne 1 du tableau des valeurs TV (=> colonne I)
Next I 'prochaine ligne de la boucle
TMP1 = Dico.Keys 'récupère dans le tableau temporaire TMP la liste du dictionnaire Dico sans doublon
'tri
For I = LBound(TMP1) To UBound(TMP1) 'boucle 1 : sur tous les éléments du tableau TMP1
  For J = LBound(TMP1) To UBound(TMP1) 'boucle 2 : sur tous les éléments du tableau TMP1
  'si I est différent de J et TMP(I) est inférieur à TMP(J)'TMP(J) devient TMP(I) est inversément
  If I <> J And TMP1(I) < TMP1(J) Then T = TMP1(I): TMP1(I) = TMP1(J): TMP1(J) = T
  Next J 'prochain élément de la boucle 2
Next I 'prochain élément de la boucle 1
ReDim TMP2(UBound(TMP1) * 2) 'redimensionne le tableau TMP2 (2 fpois plus que TMP1)
For I = LBound(TMP1) + 1 To UBound(TMP1) 'boucle sur tous les éléments du tableau TMP1 (en partant du second)
  TMP2(L) = TMP1(I) 'récupère l'élément I du tableau TMP1 dans l'élément L de TMP2
  TMP2(L + 1) = "" 'Télément TMP2 de L+1 est vide
  L = L + 2 'incrément L de 2
Next I 'prochain élément de la boucle
DL = D.Cells(Application.Rows.Count, "I").Row 'définit la dernière ligne éditée DL de la colonne I de l'onglet D
D.Range("I2:I" & DL).Clear 'efface d'éventuelles anciennes données
D.Range("I2").Resize(UBound(TMP2), 1).Value = Application.Transpose(TMP2)  'renvoie le tableau TMP2 à partir de I2
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
fin = Timer - deb
MsgBox fin
End Sub
[Édition]
Nos posts se sont croisés...
 

Robert

XLDnaute Barbatruc
Re,

Méthode 1, change la partie par :

VB:
D.Range("I3").Resize(UBound(TMP) + 1, 1).Value = Application.Transpose(Dico.Keys) 'renvoie la liste sans doublon à partir de I2
D.Range("I1:I" & UBound(TMP) + 1).Sort Key1:=D.Range("I3"), Header:=xlYes 'tri
lig = D.Range("I" & Rows.Count).End(xlUp).Row 'définit la dernière ligne éditée lig de la colonne I de l'onglet D
For I = 4 To lig * 2
  Sheets("DONNEES").Range("I" & I).Insert (xlDown)
  I = I + 1
Next I
Méthode 2, change la partie par :
VB:
D.Range("I2").Resize(UBound(TMP2), 1).Value = Application.Transpose(TMP2)
 

moutchec

XLDnaute Occasionnel
bonjour et merci bcp pour votre aide.
c'est en plus très instructif avec les commentaires!!!
cordialement.
Moutchec.
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas