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.
 

Pièces jointes

  • classeur1.xlsm
    246.5 KB · Affichages: 21

Robert

XLDnaute Barbatruc
Repose en paix
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
 

Robert

XLDnaute Barbatruc
Repose en paix
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,

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
Repose en paix
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
Repose en paix
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)
 

Discussions similaires

Réponses
18
Affichages
483
Réponses
25
Affichages
1 K

Statistiques des forums

Discussions
311 720
Messages
2 081 886
Membres
101 830
dernier inscrit
sonia poulaert