Reconnaissance de date

Bonjour à tous,

Voilà mon problème : j'ai un userform via lequel l'utilisateur rentre la date du jour, le nom d'un document et l'objet de la modification (tout est rentré dans un tableau par la suite). J'aimerais que lorsque la date n'est pas encore dans le tableau, une nouvelle ligne se crée mais quand la date y est déjà, les informations viennent s'ajouter à la ligne déjà existante (donc sans écraser les données déjà présentes)

--> Voir fichier joint

Voici le code que j'ai actuellement (ne s'applique pas au fichier joint qui sert uniquement d'exemple, je ne peux pas vous montrer le vrai fichier)

    Dim NumLigneVide As Integer

    NumLigneVide = 3

    Do Until Cells(NumLigneVide, 2).Value = ""

    Loop

    If Cells(NumLigneVide, 2) = Date Then

        Cells(NumLigneVide, 3).Value = (Cells(NumLigneVide, 5)) & Chr(10) & "" & Chr(10) & TextBox_Documents.Value
        Cells(NumLigneVide, 4).Value = (Cells(NumLigneVide, 5)) & Chr(10) & "" & Chr(10) & TextBox_Modifications.Value

    Else

            NumLigneVide = 7

            Do Until Cells(NumLigneVide, 2).Value = ""

            NumLigneVide = NumLigneVide + 1

            Loop

            Cells(NumLigneVide, 3).Value = DateValue(TextBox_Jour_Utilisateur.Value & "/" & TextBox_Mois_Utilisateur & "/" & TextBox_Annee_Utilisateur.Value)
            Cells(NumLigneVide, 5).Value = TextBox_Documents.Value
            Cells(NumLigneVide, 6).Value = TextBox_Modifications.Value

            Cells(NumLigneVide, 3).EntireRow.AutoFit

            MsgBox ("Tableau de suivi des modifications mis à jour")     

            UserForm_Utilisateur.Hide
            Unload UserForm_Utilisateur

    End If

Je vous remercie d'avance,

Cdlt

Bonjour Antonio, bonjour le forum,

Peut-être comme ça :

Sub Macro1()
Dim O As Worksheet
Dim TV As Variant
Dim DT As Date

Set O = Worksheets("Feuil1")
TV = O.Range("B2").CurrentRegion
DT = CDate(DateSerial(TextBox_Annee_Utilisateur.Value, TextBox_Mois_Utilisateur.Value, TextBox_Jour_Utilisateur.Value))
For I = 2 To UBound(TV, 1)
    If TV(I, 5) = DT Then
        LI = I + 1
        Cells(LI, "C").Value = Cells(LI, "C").Value & Chr(13) & TextBox_Documents.Value
        Cells(LI, "D").Value = Cells(LI, "D").Value & Chr(13) & TextBox_Modifications.Value
        Cells(LI, 3).EntireRow.AutoFit
        Exit For
    Else
        LI = O.Range("B2").End(xlDown).Row + 1
        Cells(LI, "B").Value = DT
        Cells(LI, "C").Value = TextBox_Documents.Value
        Cells(LI, "D").Value = TextBox_Modifications.Value
    End If
Next I
MsgBox ("Tableau de suivi des modifications mis à jour")
UserForm_Utilisateur.Hide
Unload UserForm_Utilisateur
End If
End Sub

Bonjour, merci pour votre aide, mais je crois que ça ne fonctionne pas : la ligne

If TV(I, 5) = DT Then

pose problème (Erreur d'exécution'9' : l'indice n'appartient pas à la sélection)

Cdlt,

Re,

Oui en effet il y a une erreur. Remplace TV(I, 5) par TV(I, 1). Désolé...

Re, merci bien, alors maintenant ça marche mais ça écrit 5 fois la même ligne en dessous du tableau, puis 10, puis 20 quand on recommence etc...

Re,

Si tu avais envoyé le fichier avec l'UserForm, j'aurais pu tester avant de t'envoyer...

Re, oui désolé je ne peux pas envoyer le fichier original par soucis de confidentialité, mais voici le fichier avec l'user form

Encore merci pour votre temps et votre aide

Re,

Et moi si j'avais pris le temps de réfléchir j'aurais évité d'écrire des c**neries...

Sub Macro1()
Dim O As Worksheet
Dim PL As Range
Dim TV As Variant
Dim DT As Date
Dim TEST As Boolean

Set O = Worksheets("Feuil1")
Set PL = O.Range("B2").CurrentRegion
TV = PL
DT = CDate(DateSerial(TextBox_Annee_Utilisateur.Value, TextBox_Mois_Utilisateur.Value, TextBox_Jour_Utilisateur.Value))
For I = 2 To UBound(TV, 1)
    If TV(I, 1) = DT Then
        LI = I + 1
        TEST = True
        Exit For
    Else
        LI = O.Range("B2").End(xlDown).Row + 1
    End If
Next I
If TEST = True Then
    Cells(LI, "C").Value = Cells(LI, "C").Value & Chr(13) & TextBox_Documents.Value
    Cells(LI, "D").Value = Cells(LI, "D").Value & Chr(13) & TextBox_Modifications.Value
    Cells(LI, 3).EntireRow.AutoFit
Else
    Cells(LI, "B").Value = DT
    Cells(LI, "C").Value = TextBox_Documents.Value
    Cells(LI, "D").Value = TextBox_Modifications.Value
    ActiveSheet.ListObjects("Tableau1").Resize O.Range("B2").CurrentRegion
End If
MsgBox ("Tableau de suivi des modifications mis à jour")
UserForm_Utilisateur.Hide
Unload UserForm_Utilisateur
End Sub

Re,

Avec l'UserForm c'est mieux... Code qui fonctionne bien :

Private Sub CommandButton1_Click()
Dim O As Worksheet
Dim PL As Range
Dim TV As Variant
Dim DT As Date
Dim TEST As Boolean

Set O = Worksheets("Feuil1")
Set PL = O.Range("B2").CurrentRegion
TV = PL
DT = CDate(DateSerial(TextBox_Annee_Utilisateur.Value, TextBox_Mois_Utilisateur.Value, TextBox_Jour_Utilisateur.Value))
For I = 2 To UBound(TV, 1)
    If TV(I, 1) = DT Then
        LI = I + 1
        TEST = True
        Exit For
    Else
        LI = O.Range("B2").End(xlDown).Row + 1
    End If
Next I
If TEST = True Then
    Cells(LI, "C").Value = Cells(LI, "C").Value & Chr(10) & TextBox_Documents.Value
    Cells(LI, "D").Value = Cells(LI, "D").Value & Chr(10) & TextBox_Modifications.Value
    Cells(LI, 3).EntireRow.AutoFit
Else
    Cells(LI, "B").Value = DT
    Cells(LI, "C").Value = TextBox_Documents.Value
    Cells(LI, "D").Value = TextBox_Modifications.Value
    ActiveSheet.ListObjects("Tableau1").Resize O.Range("B2").CurrentRegion
End If
MsgBox ("Tableau de suivi des modifications mis à jour")
Unload Me
End Sub

Merci beaucoup pour ce code qui fonctionne bien dans mon fichier test, mais quand je le transpose à mon vrai fichier, les variables "I" et "LI" ne sont pas reconnues (je ne sais pas pourquoi ça ne pose pas problème sur le fichier test d'ailleurs)... Une idée ? Merci beaucoup d'avance

Bon finalement il s'avère que j'ai beaucoup de mal à transposer le code dans mon fichier d'origine .. Alors le voici avec le minimum de choses, si vous pouviez adapter le code à ce fichier ça serait adorable car j'ai beaucoup d'erreurs quand j'essaie de le faire par moi même ...

Cordialement et merci beaucoup,

Re,

Pour que ça colle il faut que le tableau de départ commence au même endroit que le tableau du fichier exemple. Sinon il faut adapter le code... Sache le pour la prochaine fois...

D'accord j'y penserai pour la prochaine fois, mais du coup je me sens mal de vous demander ça mais serait-ce possible d'avoir le code adapté ? Je débute en VBA et je n'arrive pas à régler les soucis ..

Re,

Le code adapté et modifié.

Option Explicit

Private Sub UserForm_Initialize()
TextBox_Jour_Utilisateur.Value = Day(Date)
TextBox_Mois_Utilisateur.Value = Month(Date)
TextBox_Annee_Utilisateur.Value = Year(Date)
End Sub

Private Sub ComboBox_Utilisateur_Enter()
Dim DerniereLigne As Integer
Dim Utilisateur As String

With Worksheets("Catalogue")
    DerniereLigne = .Range("A1048576").End(xlUp).Row
    Utilisateur = .Range(.Cells(2, 1), .Cells(DerniereLigne, 1)).Address
    ComboBox_Utilisateur.RowSource = "Catalogue!" + Utilisateur
End With
End Sub

Private Sub CommandButton_Valider_Utilisateur_Click()

Dim O As Worksheet
Dim PL As Range
Dim TV As Variant
Dim DT As Date
Dim TEST As Boolean
Dim i As Integer
Dim LI As Integer

Set O = Worksheets("Historique des modifications")
Set PL = O.Range("C7").CurrentRegion
If ComboBox_Utilisateur <> "" And _
   TextBox_Jour_Utilisateur <> "" And _
   TextBox_Mois_Utilisateur <> "" And _
   TextBox_Annee_Utilisateur <> "" And _
   TextBox_Documents <> "" And _
   TextBox_Modifications <> "" Then
    TV = PL
    DT = CDate(DateSerial(TextBox_Annee_Utilisateur.Value, TextBox_Mois_Utilisateur.Value, TextBox_Jour_Utilisateur.Value))
    For i = 6 To UBound(TV, 1)
        If TV(i, 1) = DT Then
            LI = i + 1
            TEST = True
            Exit For
        Else
            LI = O.Range("C6").End(xlDown).Row + 1
        End If
    Next i
    If TEST = True Then
        O.Cells(LI, "E").Value = Cells(LI, "C").Value & Chr(10) & "" & Chr(10) & TextBox_Documents.Value
        O.Cells(LI, "F").Value = Cells(LI, "D").Value & Chr(10) & "" & Chr(10) & TextBox_Modifications.Value
        O.Rows(LI).AutoFit
    Else
        Cells(LI, "C").Value = DT
        Cells(LI, "D").Value = ComboBox_Utilisateur.Value
        Cells(LI, "E").Value = TextBox_Documents.Value
        Cells(LI, "F").Value = TextBox_Modifications.Value
        O.ListObjects("Tableau3").Resize O.Range("C6:F" & O.Cells(Application.Rows.Count, "C").End(xlUp).Row)
    End If
    MsgBox ("Tableau de suivi des modifications mis à jour")
    ComboBox_Utilisateur.Value = ""
    TextBox_Jour_Utilisateur.Value = ""
    TextBox_Mois_Utilisateur.Value = ""
    TextBox_Annee_Utilisateur.Value = ""
    TextBox_Documents.Value = ""
    TextBox_Modifications.Value = ""
    Unload Me
Else
    MsgBox ("Le formulaire est incomplet")
End If
End Sub

Private Sub CommandButton_Quitter_Click()
Unload Me
End Sub

En VBA, évite toujours les Select / Activate inutiles. Ils ne font que ralentir l'exécution du code et sont sources de plantage...

Ça marche merci beaucoup !! Bonne fin de journée