Enregistrer des données en fonction de la date

[anthonygg]

Bonjour,

J'aimerai enregistrer des informations dans une feuille Excel en fonction de la date avec un bouton.
J'ai une date, un nombre d'heures travaillés, et un nombre de pièces produite.

Voici le fichier que j'aimerais avoir :

 

[Modeste]

Re : Enregistrer des données en fonction de la date

Bonjour anthonygg,

Peut-être avec ce code dans la feuille de code de la feuille "Tableau", associé ensuite à ton bouton:

Sub recopie()
On Error Resume Next
lig = Application.Match([B3], Sheets("data").[B1:B32], 0)
If IsError(lig) Then MsgBox "date non trouvée": Exit Sub
[C3].Resize(1, 2).Copy Sheets("data").Cells(lig, 3)
End Sub

 

[vgendron]

Re : Enregistrer des données en fonction de la date

Bonjour,

Essaie avec ce code dans un module

Sub recopie()

jour = ActiveSheet.Range("B3")
nbh = ActiveSheet.Range("C3")
Production = ActiveSheet.Range("D3")

With Sheets("data")

    Set ligne = .Range("B2:B32").Find(Date)
    If Not ligne Is Nothing Then
        MsgBox ligne.Row
        .Range("C" & ligne.Row) = nbh
        .Range("D" & ligne.Row) = Production
    End If
End With
End Sub

à noter. le cas "si la date n'existe pas" n'est pas traité
tout comme le cas, si la date est déjà remplie

à voir en fonction de ce que tu veux faire

 

[anthonygg]

Re : Enregistrer des données en fonction de la date

Ça marche super ! Bravo ! C'est ce que je voulais !

J'aimerais rajouter une sécurité : Imaginons que j'ai déjà des données pour une date ... Et que je réenregistre des données sur cette même date ... J'aimerai avoir un message qui me dise "Êtes vous sur de vouloir remplacer ces données pour le 26/01/01 ?"
Est-ce possible ? 😛

 

[vgendron]

Re : Enregistrer des données en fonction de la date

Re
(hello Modeste)

Sub recopie()

jour = ActiveSheet.Range("B3")
nbh = ActiveSheet.Range("C3")
Production = ActiveSheet.Range("D3")

With Sheets("data")

    Set ligne = .Range("B2:B32").Find(Date)
    If Not ligne Is Nothing Then
        If (.Range("C" & ligne.Row) <> "") Then
            rep = MsgBox("il y a déjà des data, voulez vous les écraser?", vbYesNo)
            If rep = 6 Then
                .Range("C" & ligne.Row) = nbh
                .Range("D" & ligne.Row) = Production
            End If
        End If
    End If
End With
End Sub

 

[Modeste]

Re : Enregistrer des données en fonction de la date

Re,
Salut vgendron 🙂

Une petite variante, donc (et tu auras le choix):

Sub recopie()
Const auxOubliettes = 1
On Error Resume Next
lig = Application.Match([B3], Sheets("data").[B1:B32], 0)
If IsError(lig) Then MsgBox "date non trouvée": Exit Sub
If Sheets("data").Cells(lig, 3) <> "" Then prudence = MsgBox("Des données figurent déjà en regard de cette date. Voulez-vous les remplacer?", vbOKCancel)
If prudence = auxOubliettes Then [C3].Resize(1, 2).Copy Sheets("data").Cells(lig, 3)
End Sub

 

[anthonygg]

Re : Enregistrer des données en fonction de la date

Hahaha super les gars merci ! Mon petit programme est fait du coup ^^

J'ai juste un soucis qui me gène ... Quand je met les données dans le tableau avec le bouton la couleur grise sur les weeks end s'effacent :'(

 

[Modeste]

Re : Enregistrer des données en fonction de la date

Re²,

Il y avait un autre souci avec mon dernier code ... corrigé ci-dessous:

Sub recopie()
On Error Resume Next
lig = Application.Match([B3], Sheets("data").[B1:B32], 0)
If IsError(lig) Then MsgBox "date non trouvée": Exit Sub
If Sheets("data").Cells(lig, 3) <> "" Then prudence = MsgBox("Des données figurent déjà en regard de cette date. Voulez-vous les remplacer?", vbOKCancel)
If prudence < 2 Then [C3].Resize(1, 2).Copy: Sheets("data").Cells(lig, 3).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
End Sub

... Pense à tester différents cas de figure!

 

[vgendron]

Re : Enregistrer des données en fonction de la date

Re
voici une correction
mon code ne marchait que pour le 26/01.. et demain n'aurait marché que pour le 27/01..
un problème de "Date" au lieu de jour ;-)

Sub recopie()

jour = ActiveSheet.Range("B3")
nbh = ActiveSheet.Range("C3")
Production = ActiveSheet.Range("D3")

With Sheets("data")

    Set ligne = .Range("B2:B32").Find(jour)
    If Not ligne Is Nothing Then
        If (.Range("C" & ligne.Row) <> "") Then
            rep = MsgBox("il y a déjà des data, voulez vous les écraser?", vbYesNo)
            If rep = 7 Then
                Exit Sub
            Else
                .Range("C" & ligne.Row) = nbh
                .Range("D" & ligne.Row) = Production
            End If
        End If
    End If
End With
End Sub

par contre, pour la couleur grise. chez moi, ca ne change pas le fond... ??