Verifier si date est DEJA saisie

Bonjour le forum

Petite question sur lesquel je bloque .

j'ajoute des dates via un DTpicker dans une feuille excel ("date").

quel serait le code pour verifier que la date n'est PAS dans la feuille.

EXEMPLE:

1) je selectionne le 18/03/20019 dans le DTpicker

2) verification et si existe message date deja saisie

3 si existe pas saisir la date a la derniere ligne vide.

voic mon code actuel

Private Sub CommandButton1_Click()

l = Sheets("date").Range("a65536").End(xlUp).Row + 1
With Sheets("date")

    .Range("A" & l).Value = Int(CDate(DTPicker5))
 End With

MsgBox ("Date ajouté ! Au suivant...")
Sheets("date").Visible = True
Sheets("date").Select
    Columns("A:A").Select
    ActiveWorkbook.Worksheets("date").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("date").Sort.SortFields.Add Key:=Range("A1:A300"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("date").Sort
        .SetRange Range("A1:A300")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Sheets("date").Visible = False
Unload Me
End Sub

Private Sub UserForm_Initialize()
DTPicker5.Value = Now
End Sub

Merci de votre aide

Bonjour,

Ton code est un peu brouillon, j'ai fait des modifications au pied levé, a tester donc :

Private Sub CommandButton1_Click()

Dim l As Long, MaDate As Long, Rech As Variant

With Sheets("date")
   .Visible = True
   l = .Range("A65536").End(xlUp).Row + 1
   MaDate = Int(CDate(DTPicker5))
   Set Rech = .Columns("A:A").Find(MaDate, LookAt:=xlWhole, LookIn:=xlValues)
   If Not Rech Is Nothing Then
       MsgBox("Date déjà présente en ligne : " & Rech.Row)
   Else
       .Range("A" & l).Value = Int(CDate(DTPicker5))
       MsgBox ("Date ajouté ! Au suivant...")
       .Sort.SortFields.Clear
       .Sort.SortFields.Add Key:=Range("A1:A" & l), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
       .Sort.SetRange Range("A1:A" & l)
       .Sort.Header = xlGuess
       .Sort.MatchCase = False
       .Sort.Orientation = xlTopToBottom
       .Sort.SortMethod = xlPinYin
       .Sort.Apply
   End If
   .Visible = False
End With
Unload Me
End Sub

bonjour Pedro22

desoler cela ne fonctionne pas

voici un extrait du fichier pour les test.

Merci de ton aide

Ton fichier est incomplet et tu ne me dis pas où ça plante...

A tout hasard, essaie ce code :

Private Sub CommandButton1_Click()

Dim l As Long, MaDate As Long, Rech As Variant

With Sheets("date")
    .Visible = True
    l = .Range("A65536").End(xlUp).Row + 1
    MaDate = Int(CDate(DTPicker5))
    Set Rech = .Columns("A:A").Find(MaDate, LookAt:=xlWhole, LookIn:=xlValues)
    If Not Rech Is Nothing Then
        MsgBox ("Date déjà présente en ligne : " & Rech.Row)
    Else
        .Range("A" & l).Value = Int(CDate(DTPicker5))
        MsgBox ("Date ajouté ! Au suivant...")
        .Columns("A:A").Select
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=Range("A1:A" & l), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With ActiveWorkbook.Worksheets("date").Sort
             .SetRange Range("A1:A" & l)
             .Header = xlGuess
             .MatchCase = False
             .Orientation = xlTopToBottom
             .SortMethod = xlPinYin
             .Apply
        End With
    End If
    .Visible = False
End With
Unload Me
End Sub

Re bonjour.

En effet autant pour moi.

En fait quand je saisie une date déjà dans la liste, je peux la saisir plusieurs fois.

Je teste ça.

je viens de tester mais apparemment cela vient du format de cellule.

quand je met le format de cellule en standard cela fonctionne mais une l'orsque je rentre une date elle est saisie au format date

Merci encore.

Re bonjour

J'ai trouver une solution certe pas très élégante mais cela fonctionne.

Columns("A:A").Select
    Selection.NumberFormat = "General"

au début

et

Columns("A:A").Select
    Selection.NumberFormat = "[$-x-sysdate]dddd, mmmm dd, yyyy"[/i][/b]

ala fin

Private Sub CommandButton1_Click()
          Columns("A:A").Select
    Selection.NumberFormat = "General"
Dim l As Long, MaDate As Long, Rech As Variant

With Sheets("date")
    .Visible = True
    l = .Range("A65536").End(xlUp).Row + 1
    MaDate = Int(DTPicker5)
    Set Rech = .Columns("A:A").Find(MaDate, LookAt:=xlWhole, LookIn:=xlValues)
    If Not Rech Is Nothing Then
        MsgBox ("Date déjà présente en ligne : " & Rech.Row)
    Else
        .Range("A" & l).Value = Int(CDate(DTPicker5))
        MsgBox ("Date ajouté ! Au suivant...")
        .Columns("A:A").Select
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=Range("A1:A" & l), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With ActiveWorkbook.Worksheets("date").Sort
             .SetRange Range("A1:A" & l)
             .Header = xlGuess
             .MatchCase = False
             .Orientation = xlTopToBottom
             .SortMethod = xlPinYin
             .Apply
        End With
    End If
         Columns("A:A").Select
    Selection.NumberFormat = "[$-x-sysdate]dddd, mmmm dd, yyyy"
    '.Visible = False
End With
Unload Me
End Sub

En tout cas merci

Bonjour,

Retire autant que possible les instructions "Select" inutiles, par exemple :

Columns("A:A").Select
    Selection.NumberFormat = "General"

S'écrit aussi bien :

Columns("A:A").NumberFormat = "General"