Retrouver une date dans une liste

Version imprimable

06/03/2013, 11h16
gilou41

Retrouver une date dans une liste

Bonjour tout le monde
cela fait 2 jour que je piétine sur un problème de date et je vous appelle donc à mon secours
En feuil1 cellule A1 une date et en B1 des données associées à cette date
En Feuil2 colonne A:A une liste de dates et en B:B les donées associées

Mon problème:
Si la date de Feuil1 est déjàa présente dans Feuil2 afficher un message d'erreur
Si la date Feuil1 n'est pas présente en Feuil2 copier cetee date en fin de liste et copier également les données associées

Si quelqu'un peut m'aider pour ce code je lui en serait reconnaissant
Merci d'avance et bonne journée à tous

Bonjour,

Code:

1
2
3
4
5
6
7
8
9
10
11
12
Sub Copier()
Dim DerLig As Long
    With Worksheets("Feuil2")
        DerLig = .Range("A" & Rows.Count).End(xlUp).Row
        If Application.CountIf(.Range("A1:A" & DerLig), Worksheets("Feuil1").Range("A1").Value) > 0 Then
            MsgBox "Cette date est déjà présente dans la feuille2"
        Else
            Worksheets("Feuil1").Range("A1").Resize(1, 2).Copy .Range("A" & DerLig + 1)
            MsgBox "Date et données associées enregistrées"
        End If
    End With
End Sub

Cordialement.

Bonjour,

Voici un bout de code qui devrait répondre à tes attentes :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub TestDate()
 
    Dim CellATester As Range
    Dim DateTest As Date
    Dim DerniereLigne As Integer
 
    DateTest = Sheets("Feuil1").Range("A1")
    DerniereLigne = Sheets("Feuil2").Range("A65536").End(xlUp).Row
    Set CellATester = Sheets("feuil2").Range("A1:A" & DerniereLigne)
 
    For Each cel In CellATester
        If DateTest = cel Then
            MsgBox "Date déja présente"
            Exit Sub
        End If
    Next
 
    Sheets("feuil2").Range("A" & DerniereLigne + 1) = DateTest
    Sheets("feuil2").Range("B" & DerniereLigne + 1) = Sheets("feuil1").Range("B1")
msgbox "Données enregistrées
 
End Sub

Bonjour,

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub TestDate()
 
    Dim CellATester As Range
    Dim DateTest As Date
    Dim DerniereLigne As Integer
 
    DateTest = Sheets("Feuil1").Range("A1")
    Set CellATester = Sheets("feuil2").Columns("A:A")
On Error Resume Next
Debug.Print CellATester.Find(DateTest).Row
If Err = 0 Then
   MsgBox "Date déja présente"
    Exit Sub
End If
  On Error GoTo 0
  Dim R As Long
 R = Sheets("feuil2").Range("A1").CurrentRegion.Rows.Count + 1
 
    Sheets("feuil2").Range("A" & R) = DateTest
    Sheets("feuil2").Range("B" & R) = Sheets("feuil1").Range("B1")
MsgBox "Données enregistrées"
 
End Sub

06/03/2013, 13h29
Guiiand

Bonjour rdurupt,

Pourrais tu m'éclairer sur les changement que tu as apporté au code que j'ai proposé, je ne saisis pas la "valeur ajoutée" des modifications.

Est ce plus rapide, ou plus "costaud" pour la gestion des erreurs, désolé si je ne saisis pas la subtilité.

Bonne journée

Cdt
06/03/2013, 13h44
gilou41

merci pour vos 3 propositions
06/03/2013, 13h56
Invité

1 pièce(s) jointe(s)

bonjour Guiiand,
J’utilise la même méthode qu'Excel quand tu recherches une valeur dans une colonne.
C’est plus rapide mais ça génère une erreur quand la valeur n’est pas trouvée d’où le On Error Resume Next
06/03/2013, 14h19
Guiiand

Mes yeux ne voyaient pas le .Find :mouarf: