Tri de date dans une seule colonne avec un userform

Le 13/12/2016 à 01:12

Bonjour tout le monde,

Je vous rejoins aujourd'hui pour requérir votre aide.

En effet j'ai un fichier excel sur lequel nous enregistrons nos rebuts de production.

Nous les enregistrons par date, avec d'autres informations bien sûr.

Chaque rebut est égal à une ligne et nous les incrémentons par le haut du tableau, cela veut dire que ceux du 1er janvier sont tout en bas.

Je souhaiterais créer une macro qui, à l'aide d'un userform dans lequel j'écris la date souhaitée, me permet d'aller trier et d'afficher dans ce classeur uniquement la date souhaitée.

La feuille s'appelle "suivi des rebuts" et les dates sont dans la colonne "b" (pour info il y a environ 16000 lignes actuellement).

Le but de cette manœuvre , vous allez me dire "donnée" "trier" fera l'affaire, mais non, est en suite de compter le nombre de ligne, créer autant de ligne dans un autre classeur et effectuer un copier valeur.

Je vous remercie par avance et je suis à dispo pour tout renseignements complémentaire.

Le 13/12/2016 à 09:06

Bonjour et bienvenue sur le forum

Joins ton fichier, ce sera plus facile de te faire une proposition.

Bye !

Le 13/12/2016 à 09:55

Salut GMB,

Je serais au bureau dans l’après-midi, je posterai les deux fichiers.

Merci

Le 13/12/2016 à 10:24

Bonjour le fil, bonjour le forum,

Un petit exemple de ce qui peut se faire (facilement adaptable). Tu cliques sur le bouton Date, tu rentres une date et dans l'onglet Feuill2 sont renvoyées toutes les lignes contenant cette date en colonne B. Un message indique combien de lignes il y a. Tu n'auras ensuite qu'à copier ces lignes et les insérer dans ton autre tableau.

Code commenté...

53leboucher-v01.xlsm (31.87 Ko)

Le 13/12/2016 à 18:11

Merci Tautheme, je regarde ça et je reviens vers vous.

A+

Le 14/12/2016 à 19:51

Salut Tautheme,

Je te remercie pour ton bout de code, je l'ai modifié pour correspondre à mes besoins et cela fonctionne bien.

Maintenant il me reste à le terminer car il me reste encore des actions à coder

Je te remet ton code en entier pour que tu vois mes modifs.

Le truc, c'est que j'ai rajouté un bout de code qui est censé me permettre de récupérer le nombre de lignes créées par ton code, j'ai essayé de me servir de la variable "NL" mais je ne comprends pas pourquoi cela ne marche pas.

Le reste du code que j'ai rajouté est censé m'activer un autre classeur et insérer par le haut le nombre de ligne récupérées. La cellule de départ est B2.

Tu verras que je conditionne également la hauteur des lignes.

La prochaine étape est de revenir les lignes que ton code a généré, de les copier et les coller/valeur dans les lignes que nous venons de créer.

Ouha, j'éspère que c'est clair, moi je sais ce que je veux, maintenant le demander par écrit c'est pas si simple !!!

Merci beaucoup en tout cas.

Option Explicit 'oblige à déclarer toutes les variables

Private Sub UserForm_Initialize() 'à l'initialisation de l'UserForm
'affiche la date du jour
Me.TextBox1.Value = Format(Day(Date), "00") 'jour JJ
Me.TextBox2.Value = Format(Month(Date), "00") 'mois MM
Me.TextBox3.Value = Right(Year(Date), 2) 'années YY
'sélectionne le jour
With Me.TextBox1 'prend en compte la TextBox1
    .SetFocus 'place le curseur
    .SelStart = 0 'début de la sélection
    .SelLength = 2 'longueur de la sélection
End With 'fin de la prise en compte de la TextBox1
End Sub

Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) 'à l'appui sur une touche dans la Textbox1
If KeyAscii > 57 Or KeyAscii < 48 Then KeyAscii = 8 'interdit tout autre caractère que {0, 1, 2, 3, 4, 5, 6, 7, 8 ou 9]
End Sub

Private Sub TextBox2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) 'à l'appui sur une touche dans la Textbox2
If KeyAscii > 57 Or KeyAscii < 48 Then KeyAscii = 8 'interdit tout autre caractère que {0, 1, 2, 3, 4, 5, 6, 7, 8 ou 9]
End Sub

Private Sub TextBox3_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) 'à l'appui sur une touche dans la Textbox3
If KeyAscii > 57 Or KeyAscii < 48 Then KeyAscii = 8 'interdit tout autre caractère que {0, 1, 2, 3, 4, 5, 6, 7, 8 ou 9]
End Sub

Private Sub CommandButton1_Click() 'bouton "OK"
Dim DR As Date 'déclare la variable DR (Date de Référence)
Dim VDR As Long 'déclare la variable VDR (Valeur Date de Référence)
Dim DT As Date 'déclare la variable DT (Date Trouvée)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim TV As Variant 'déclare la variable TV (Tableau des valeurs)
Dim NL As Long 'déclare la variable NL (Nombre de Lignes)
Dim NC As Integer 'déclare la variable NC (Nombre de Colonnes)
Dim I As Long 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Long 'déclare la variable K (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)

DR = DateSerial(2000 + CInt(Me.TextBox3.Value), CInt(Me.TextBox2.Value), CInt(Me.TextBox1.Value)) 'définit la date de référence DR
VDR = CLng(DR) 'définit la valeur de la date de référence VDR
Unload Me 'vide et ferme l'UserForm
Set OS = Worksheets("Suivi des rebuts") 'définit l'onglet source OS (à adapter à ton cas)
Set OD = Worksheets("Feuil2") 'définit l'onglet destination OD (à adapter à ton cas)
OD.Range("A1").CurrentRegion.ClearContents 'vide d'éventuelles anciennes valeur de l'onglet destination
TV = OS.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
NL = UBound(TV, 1) 'définit le nombre de lignes NL du tableau des valeur TV
NC = UBound(TV, 2) 'définit le nombre de colonnes NC du tableau des valeur TV
K = 1 'initialise la variable K
For I = 2 To NL 'boucle 1 sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    DT = DateSerial(Year(TV(I, 2)), Month(TV(I, 2)), Day(TV(I, 2))) 'définit la date trouvée DT
    If DR = DT Then 'condition : si la date trouvée est la même que la date de référence
        ReDim Preserve TL(1 To NC, 1 To K) 'redimensionne le tableau des lignes TL (autant de lignes que TV a de colonnes, K colonnes)
        For J = 1 To NC 'boucle 2 : sur toutes les colonnes de TV
            TL(J, K) = TV(I, J) 'récupère dans la ligne de TL la valeur de la colonne de TV (=transposition)
            If J = 2 Then TL(J, K) = VDR
        Next J 'prochaine colonne de la boucle 2
        K = K + 1 'incrémente K (ajoute une colonne à TL)
    End If 'fin de la condition
Next I 'prochaine ligne de la boucle 1
If K > 1 Then 'condition : si K est supérieure à 1 (au moins une occurrence trouvée)
    OD.Range("A1").Resize(1, NC) = Application.Index(TV, 1) 'renvoie dans la cellule A1 redimensionnée de l'onglet destination la premières ligne des étiquettes de TV
    OD.Range("A2").Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL) 'renvoie dans A2 redimensionnée de l'onglet destination le tableau TL transposé
    OD.Range("B2:B" & K).NumberFormat = "dd/mm/yyyy" 'définit le format des valeurs de la colonne B
End If 'fin de la condition
MsgBox "il y a " & K - 1 & " ligne(s) !"
OD.Select 'déselectionne l'onglet destination OD
MsgBox "il y a " & K - 1 & " ligne(s) !"
End Sub
Sub Comptage()
'Compte le nombre de ligne non vide en feuille 2
    Windows("Prod-Arrêt Ligne GN4-2016.xlsm").Select
    Sheets("Suivi des rebuts").Select
    Rows("2:NL").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.RowHeight = 15
End Sub

Le 14/12/2016 à 21:01

Bonsoir Leboucher, bonsoir le forum,

Voilà le nouveau code qui fait tout. Il te faudra le placer dans le classeur source (celui qui contient les données avec les dates) et adapter le nom de l'onglet des données (moi je l'ai appelé Feuil1, tu adapteras) :

Le code

Option Explicit 'oblige à déclarer toutes les variables

Private Sub UserForm_Initialize() 'à l'initialisation de l'UserForm
'affiche la date du jour
Me.TextBox1.Value = Format(Day(Date), "00") 'jour JJ
Me.TextBox2.Value = Format(Month(Date), "00") 'mois MM
Me.TextBox3.Value = Right(Year(Date), 2) 'années YY
'sélectionne le jour
With Me.TextBox1 'prend en compte la TextBox1
    .SetFocus 'place le curseur
    .SelStart = 0 'début de la sélection
    .SelLength = 2 'longueur de la sélection
End With 'fin de la prise en compte de la TextBox1
End Sub

Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) 'à l'appui sur une touche dans la Textbox1
If KeyAscii > 57 Or KeyAscii < 48 Then KeyAscii = 8 'interdit tout autre caractère que {0, 1, 2, 3, 4, 5, 6, 7, 8 ou 9]
End Sub

Private Sub TextBox2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) 'à l'appui sur une touche dans la Textbox2
If KeyAscii > 57 Or KeyAscii < 48 Then KeyAscii = 8 'interdit tout autre caractère que {0, 1, 2, 3, 4, 5, 6, 7, 8 ou 9]
End Sub

Private Sub TextBox3_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) 'à l'appui sur une touche dans la Textbox3
If KeyAscii > 57 Or KeyAscii < 48 Then KeyAscii = 8 'interdit tout autre caractère que {0, 1, 2, 3, 4, 5, 6, 7, 8 ou 9]
End Sub

Private Sub CommandButton1_Click() 'bouton "OK"
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim DR As Date 'déclare la variable DR (Date de Référence)
Dim VDR As Long 'déclare la variable VDR (Valeur Date de Référence)
Dim DT As Date 'déclare la variable DT (Date Trouvée)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim TV As Variant 'déclare la variable TV (Tableau des valeurs)
Dim NL As Long 'déclare la variable NL (Nombre de Lignes)
Dim NC As Integer 'déclare la variable NC (Nombre de Colonnes)
Dim I As Long 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Long 'déclare la variable K (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)

Set CS = ThisWorkbook 'définit la classeur source
On Error Resume Next 'gestion des erreurs, en cas d'erreur passe à la ligne suivante
Set CD = Workbooks("Prod-Arrêt Ligne GN4-2016.xlsm") 'définit la classeur destination
If Err <> 0 Then 'condition : si une erreur a été générée (si le classeur n'est pas ouvert cela génère une erreur)
    MsgBox "Le Classeur [Prod-Arrêt Ligne GN4-2016.xlsm] doit être ouvert ! Ouvrez-le et recommencez." 'message
    Exit Sub 'sort de la procédure
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
Set OS = CS.Worksheets("Feuil1") 'définit l'onglet source OS (à adapter à ton cas)
Set OD = CD.Worksheets("Suivi des rebuts") 'définit l'onglet destination OD
DR = DateSerial(2000 + CInt(Me.TextBox3.Value), CInt(Me.TextBox2.Value), CInt(Me.TextBox1.Value)) 'définit la date de référence DR
VDR = CLng(DR) 'définit la valeur de la date de référence VDR
Unload Me 'vide et ferme l'UserForm
TV = OS.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
NL = UBound(TV, 1) 'définit le nombre de lignes NL du tableau des valeurs TV
NC = UBound(TV, 2) 'définit le nombre de colonnes NC du tableau des valeurs TV
K = 1 'initialise la variable K
For I = 2 To NL 'boucle 1 sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    DT = DateSerial(Year(TV(I, 2)), Month(TV(I, 2)), Day(TV(I, 2))) 'définit la date trouvée DT
    If DR = DT Then 'condition : si la date trouvée est la même que la date de référence
        ReDim Preserve TL(1 To NC, 1 To K) 'redimensionne le tableau des lignes TL (autant de lignes que TV a de colonnes, K colonnes)
        For J = 1 To NC 'boucle 2 : sur toutes les colonnes de TV
            TL(J, K) = TV(I, J) 'récupère dans la ligne de TL la valeur de la colonne de TV (=transposition)
            If J = 2 Then TL(J, K) = VDR
        Next J 'prochaine colonne de la boucle 2
        K = K + 1 'incrémente K (ajoute une colonne à TL)
    End If 'fin de la condition
Next I 'prochaine ligne de la boucle 1
If K > 1 Then 'condition : si K est supérieure à 1 (au moins une occurrence trouvée)
    CD.Activate 'active le classeur destination CD
    OD.Select 'sélectionne l'onglet destination OD
    Rows("2:" & K - 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.RowHeight = 15
    'renvoie dans A2 redimensionnée de l'onglet destination le tableau TL transposé
    ActiveSheet.Range("B2").Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL)
    'définit le format des valeurs de la colonne B (ligne en dessous à modifier ou supprimer si les format sont déja OK)
    ActiveSheet.Range("C2:C" & K).NumberFormat = "dd/mm/yyyy"
End If 'fin de la condition
MsgBox K - 1 & " lignes copiées !"
End Sub

'si tu veux copier la première ligne contenant les étiquettes, la fin du code devient :
'Selection.RowHeight = 15
'ActiveSheet.Range("B2").Resize(1, NC) = Application.Index(TV, 1) 'renvoie dans la cellule A1 redimensionnée de l'onglet destination la premières ligne des étiquettes de TV
'ActiveSheet.Range("B3").Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL) 'renvoie dans A2 redimensionnée de l'onglet destination le tableau TL transposé
'ActiveSheet.Range("C3:C" & K).NumberFormat = "dd/mm/yyyy" 'définit le format des valeurs de la colonne B

Les fichiers qui vont bien pour tester :

34leboucher-v02.xlsm (34.46 Ko)

29prod-arret-ligne-gn4-2016.xlsm (8.57 Ko)

Le 14/12/2016 à 22:48

Merci pour ta rapidité,

Je teste ça demain après-midi.

Du coup mon code n'était pas adapté, moi je partais sur un copier-coller/valeur alors que tu es parti sur un tableau de valeur que tu déplace dans l'OD.

En revanche je n'ai pas compris comment tu comptes les lignes du TV et tu les insère à partir du haut ?

Le 14/12/2016 à 23:36

Re,

Je ne compte pas les lignes de TV (qui représentent toutes les lignes), mais celles de TL, qui représentent celles où les dates correspondent ! Chaque fois que la condition est avérée on incrémente K de 1 (K = K + 1). Comme on a initialisé K = 1 au début, le nombre de lignes qui vérifient la condition est, à la fin de la boucle, égal à K - 1...

Le 15/12/2016 à 15:29

Salut Tautheme,

La classe ça fonctionne a 2 petits détails prés.

Les lignes insérées dans "prod-Arrêt de ligne GN4-2016.xlms" sont décalées d'une colonne, càd, tout s'insère en C àld B et du coup, je ne sais pas si c'est lié, seule la première ligne en bas est mise en forme avec une hauteur de 15.

A+

Le 15/12/2016 à 16:40

Bonjour Leboucher, bonjour le forum,

Depuis ton premier post tu n'as pas daigné une seule fois nous proposer un fichier exemple (l'original ou, s'il y a des données confidentielles, un fichier basé sur ton original). Je ne sais pas si tu as remarqué, mais c'est moi qui te propose les fichiers exemple (le mondalenver)...

Comme te l'avait demandé gmb dès le début, il serait maintenant grand temps que tu y mettes un peu du tien pour éviter de nous perdre en questions / réponses infructueuses.

Le 15/12/2016 à 19:22

Tautheme,

Désolé de t'agacer, mais vu tes propositions de codes sans même avoir de fichier source je ne pensais vraiment pas que cela te chagrinais, comme tu as pu le voir je suis nouveau sur ce forum, ce n'est pas une excuse, mais je prends note de ta remarque.

Je te joins les deux fichiers "source = copie suivi gen4" et "destination= prod-arrêt ligne gen4-2016".

Le code que tu m'as fourni est modifié pour ces deux fichiers.

Voilà, encore merci et loin de toi l'idée de vouloir vous faire perdre du temps.

15copie-de-suivi-gen4.xlsm (437.58 Ko)

17prod-arret-ligne-gn4-2016.xlsm (269.85 Ko)

Le 16/12/2016 à 23:46

Bonsoir Leboucher, bonsoir le forum,

Désolé pour le retard mais moins disponible ces derniers temps...

Je remarque tu as placé le code dans le classeur destination alors que je l'avais placé dans le classeur source. Pour moi, le classeur source est celui qui contient les données qui vont être copiées alors que le classeur destination est celui dans lequel les données copiées vont être collées. J'ai donc adapté selon ton fichier exemple.

Je comprends maintenant pourquoi le décalage puisque tu as une colonne semaine en A et une colonne Mois en Q qui ne sont pas reportées dans le classeur destination !... Tes lignes bicolores issues d'une MFC retardent considérablement l'exécution du code. D'ailleurs, ça me gavait tellement que j'ai supprimé les MFC.

En pièce jointe ton fichier destination avec le code adapté et fonctionnel, pour le peu que j'ai testé.

Le code :

Private Sub CommandButton1_Click() 'bouton "OK"
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim DR As Date 'déclare la variable DR (Date de Référence)
Dim VDR As Long 'déclare la variable VDR (Valeur Date de Référence)
Dim DT As Date 'déclare la variable DT (Date Trouvée)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim TV As Variant 'déclare la variable TV (Tableau des valeurs)
Dim NL As Long 'déclare la variable NL (Nombre de Lignes)
Dim NC As Integer 'déclare la variable NC (Nombre de Colonnes)
Dim I As Long 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Long 'déclare la variable K (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
On Error Resume Next 'gestion des erreurs, en cas d'erreur passe à la ligne suivante
Set CS = Workbooks("Prod-Arrêt Ligne GN4-2016.xlsm") 'définit la classeur source CS
If Err <> 0 Then 'condition : si une erreur a été générée (si le classeur n'est pas ouvert cela génère une erreur)
    MsgBox "Le Classeur [Prod-Arrêt Ligne GN4-2016.xlsm] doit être ouvert ! Ouvrez-le et recommencez." 'message
    Exit Sub 'sort de la procédure
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
Set CD = ThisWorkbook 'définit la classeur destination CD
Set OS = CS.Worksheets("Suivi des rebuts") 'définit l'onglet source OS
Set OD = CD.Worksheets("Suivi des rebuts") 'définit l'onglet destination OD
DR = DateSerial(2000 + CInt(Me.TextBox3.Value), CInt(Me.TextBox2.Value), CInt(Me.TextBox1.Value)) 'définit la date de référence DR
VDR = CLng(DR) 'définit la valeur de la date de référence VDR
Unload Me 'vide et ferme l'UserForm1
TV = OS.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
NL = UBound(TV, 1) 'définit le nombre de lignes NL du tableau des valeurs TV
NC = UBound(TV, 2) 'définit le nombre de colonnes NC du tableau des valeurs TV
K = 1 'initialise la variable K
For I = 2 To NL 'boucle 1 : sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    DT = DateSerial(Year(TV(I, 2)), Month(TV(I, 2)), Day(TV(I, 2))) 'définit la date trouvée DT
    If DR = DT Then 'condition : si la date trouvée est la même que la date de référence
        ReDim Preserve TL(1 To NC - 2, 1 To K) 'redimensionne le tableau des lignes TL (autant de lignes que TV a de colonnes - 2, K colonnes)
        For J = 2 To NC - 1 'boucle 2 : sur toutes les colonnes J de TV (en partant de la seconde et sans la dernière)
            TL(J - 1, K) = TV(I, J) 'récupère dans la ligne J - 1 de TL la valeur de la colonne J de TV (=transposition)
            If J = 2 Then TL(J - 1, K) = VDR 'pour la date, récupère la variable VDR
        Next J 'prochaine colonne de la boucle 2
        K = K + 1 'incrémente K (ajoute une colonne à TL)
    End If 'fin de la condition
Next I 'prochaine ligne de la boucle 1
If K > 1 Then 'condition : si K est supérieure à 1 (au moins une occurrence trouvée)
    OD.Rows("2:" & K).Insert Shift:=xlDown 'insère K lignes
    OD.Rows("2:" & K).RowHeight = 15 'définit la hquteur des lignes insérées
    'renvoie dans B2 redimensionnée de l'onglet destination le tableau TL transposé
    OD.Range("B2").Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL)
    OD.Cells(K + 1, 2).Resize(1, 15).Copy 'copy le format de la première ligne avant insertion
    OD.Cells(2, 2).Resize(K + 1, 15).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False 'colle le format dans les lignes insérées
    Application.CutCopyMode = False 'supprime le clignotement lié à la copie
    OD.Range("B2").Select 'sélectionne la cellule B2 de l'onglet OD
End If 'fin de la condition
MsgBox K - 1 & " lignes copiées !" 'message
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub

Le fichier destination :

25suivi-gen4.xlsm (264.32 Ko)

Le 17/12/2016 à 12:55

Tautheme,

Merci pour ton code, je testerais tout ça mardi matin au boulot, en attendant je laisse le post ouvert au cas ou.

En tout cas la prochaine fois que je demande de l'aide je mettrais tout de suite les fichiers (au moins adaptés) en pj.

Pas de soucis pour la suppression de la mfc.

A+

Le 20/12/2016 à 11:02

Salut Tautheme,

Apres quelques modfis mineures tout fonctionne à merveille.

Merci beaucoup pour ton aide.

A bientôt peut-être.

Rechercher des sujets similaires à "tri date seule colonne userform"