Remplir une liste déroulante avec des dates seulement

**apt** · 07/07/2012, 18h40

Bonjour à tous,

Afin d'utiliser une liste déroulante comme l'un des criteres d'un filtre élaboré, je dois la renseigner avec des dates seulement depuis une colonne qui contient des dates sous forme de jj/mm/yyyy hh:mm

10/05/2012 15:25
10/05/2012 15:25
10/05/2012 16:18
10/05/2012 16:18
10/05/2012 21:33
10/05/2012 21:33
15/05/2012 00:05
15/05/2012 09:48
15/05/2012 14:28
16/05/2012 11:24
16/05/2012 11:24
16/05/2012 11:24
16/05/2012 11:24
16/05/2012 11:24
16/05/2012 11:24
16/05/2012 11:24

Alors comment avoir une liste de validation de données avec des dates seulement (jj/mm/aaaa) sans les heures et minutes ?

Merci.

**Bear the french** · 07/07/2012, 22h05

Bonsoir apt,

Pour convertir, en admettant que tes dates sont en colonne A :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Sub convertiondate()
    For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
        Cells(i, 1).NumberFormat = "dd/mm/yyyy"
    Next
End Sub

C'est ce que tu cherches à obtenir ?

Bertrand

**apt** · 08/07/2012, 09h13

Bonjour Bear the french,

C'est ce que tu cherches à obtenir ?

Non j'aimerais alimenter une liste déroulante sur la feuille.

**Bear the french** · 08/07/2012, 11h56

Bonjour,

Si tu ne veux pas passer par VBA (menu données, validation des données, liste...), je pense que le format de ta colonne est répercuté automatiquement dans ta liste de validation. Hors, tu voudrais peut-être garder le format avec les heures sur ta feuille Excel mais ne pas l'avoir dans ta liste de validation. Sans vba, modifier le format d'une plage de cellule et cela en une unique formule --> je ne sais pas faire et je ne sais pas si celà est faisable

Peut-être que créer une colonne "à masquer" pour y loger tes dates au bon format afin que ta liste pointe dessus...

Avec VBA, ta liste de validation peut devenir une ComboBox. Dans ce cas, ta liste présente dans ComboBox peut avoir un format différent de celui de ta feuille Excel.

Je t'ai fait un petit code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub convertiondate_et_combobox()
Dim i As Integer
 
ReDim tabl((Range("A" & Rows.Count).End(xlUp).Row) - 1) As Date
 
    For i = 0 To Range("A" & Rows.Count).End(xlUp).Row - 1
        tabl(i) = Sheets("feuil1").Range("A" & i + 1).Value
        ' je change le format de la variable en enlevant les heures/minutes
        tabl(i) = Format(tabl(i), "dd/mm/yyyy")
    Next
 
    UserForm1.ComboBox1.List() = tabl
    UserForm1.Show
 
End Sub

Bertrand

**apt** · 09/07/2012, 01h25

Bonsoir Bear the french,

Envoyé par Bear the french

je ne sais pas faire et je ne sais pas si celà est faisable

C'est faisable avec cette formule matricielle :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=SI(LIGNES($8:9)<=NB(1/FREQUENCE(EQUIV(ENT(Col_Arret);ENT(Col_Arret);0);LIGNE(INDIRECT("1:"&LIGNES(Col_Arret)))));MIN(SI(NB.SI(H$7:H8;ENT(Col_Arret))=0;ENT(Col_Arret)));"")

Col_Arret : colonne des dates et heures

Colonne H : colonne de la liste des dates sans doublons, elle commence à la ligne 8

Mais est-ce pratique d'appliquer cette formule pour tous les jours de l'année, avec doublons, tout au long de centaines de ligne en bas ?

**apt** · 09/07/2012, 09h09

Bonjour,

J'ai voulu combiné ton code de la ComboBox avec un code trouvé qui constitue une liste de validation dans la feuille en VBA :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub test()
    Dim i As Integer
    ReDim tabl((Range("A" & Rows.Count).End(xlUp).Row) - 1) As Date
 
    For i = 0 To Range("A" & Rows.Count).End(xlUp).Row - 1
        tabl(i) = Sheets("feuil1").Range("A" & i + 1).Value
        ' je change le format de la variable en enlevant les heures/minutes
        tabl(i) = Format(tabl(i), "dd/mm/yyyy")
    Next
    '-- RefersTo ??? On a un tableau tabl et non pas une plage
    ActiveWorkbook.Names.Add Name:="MaListe", RefersTo:="=Feuil1!$B$3:$B$96"
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, Formula1:="=MaListe"
        .InCellDropdown = True
        .ShowError = True
    End With
End Sub

Mais reste le problème du nommage de la plage "MaListe" qui se réfère a une plage, or on a un tableau.

**Bear the french** · 09/07/2012, 10h22

Bonjour apt,

Il te faut contourner le problème... Transformer ton tableau/liste VBA en chaîne de caractères séparée par des virgules.

Testes :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Sub test()
 
    Dim i As Integer
    Dim ancienneformule As String
 
    ReDim tabl((Range("A" & Rows.Count).End(xlUp).Row) - 1) As Date
 
    For i = 0 To Range("A" & Rows.Count).End(xlUp).Row - 1
        tabl(i) = Sheets("feuil1").Range("A" & i + 1).Value
        ' je change le format de la variable en enlevant les heures/minutes
        tabl(i) = Format(tabl(i), "dd/mm/yyyy")
 
        'je renseigne ma chaîne de caractères
        If i = 0 Then
            ancienneformule = tabl(i)
        Else
            ancienneformule = ancienneformule & "," & tabl(i)
        End If
 
    Next
 
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, Formula1:=ancienneformule
        .InCellDropdown = True
        .ShowError = True
    End With
 
End Sub

Il dois y avoir des codes plus jolis (avec Join ou Split) mais l'idée reste la même.

C'est Ok ?

Bertrand

**apt** · 09/07/2012, 13h37

Bonsoir Beer the french,

En PJ un essai en VBA.

Mais que les dates récupérées sont d'une format non unique !

**Bear the french** · 09/07/2012, 14h14

Bonjour,

Je viens de vérifier... Avec mon code, ça fonctionne...
Après ta problématique est peut-être de supprimer les dates en doublon (?)

Voir en PJ.

Bertrand

**Bear the french** · 09/07/2012, 20h38

Bonsoir,

Voilà le code qui doit faire disparaitre tes doublons :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Sub listboxsansdoublon()
 
    Dim i, k As Integer
    Dim ancienneformule As String
    Set MonDico = CreateObject("Scripting.Dictionary")
 
    ReDim tabl((Range("A" & Rows.Count).End(xlUp).Row) - 2) As Date
 
    For i = 0 To Range("A" & Rows.Count).End(xlUp).Row - 2
        tabl(i) = Sheets("feuil1").Range("A" & i + 2).Value
        tabl(i) = Format(tabl(i), "dd/mm/yyyy")
    Next
 
    For i = 0 To UBound(tabl)
        If Not MonDico.Exists(tabl(i)) Then
                MonDico.Add tabl(i), tabl(i)
                If i = 0 Then
                    ancienneformule = tabl(i)
                Else
                    ancienneformule = ancienneformule & "," & tabl(i)
                End If
        End If
    Next
 
    With Range("F2").Validation
        .Delete
        .Add Type:=xlValidateList, Formula1:=ancienneformule
        .InCellDropdown = True
        .ShowError = True
    End With
 
End Sub

Bertrand

**apt** · 10/07/2012, 01h09

Bonsoir Bear the french,

Merci pour les codes, ça marche bien.

Reste un long vide après les dates (la place des heures et minutes), comment le supprimer ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
Sub ListeDate()
    Dim i%, v$, dPlg, oCel As Range, oPlg As Range
    Dim dic As Object, LastLg As Integer
    Dim fCel As String
 
    Set dic = CreateObject("Scripting.Dictionary")
 
    With Sheets("feuil2")
        LastLg = .Range("A" & .Rows.Count).End(xlUp).Row
        MsgBox "LastLg = " & LastLg
 
        Set oPlg = .Range("A1:A" & LastLg)   'plage de données
    End With
    dPlg = oPlg.Value
 
    '-- Tri
    With oPlg.Parent.Sort
        .SortFields.Clear
        .SortFields.Add Key:=oPlg.Range("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange oPlg
        .Header = xlNo    'xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .Apply
    End With
    On Error Resume Next
 
    '-- Récupérer les dates sans doublons
    For Each oCel In oPlg.Cells
        fCel = Trim(Format(oCel.Value, "dd/mm/yyyy"))
        If Not dic.Exists(fCel) Then
            'MsgBox "oCel = " & oCel & vbCrLf & _
             '       "Format(" & oCel.Value & ", dd/mm/yyyy) = " & Format(oCel.Value, "dd/mm/yyyy")
            dic.Add fCel, fCel
        End If
    Next oCel
 
    oPlg.Value = dPlg
    Set oPlg = Nothing
    Erase dPlg
    On Error GoTo 0
    Sheets("feuil2").Range("B2").Resize(dic.Count, 1) = Application.Transpose(dic.keys)
 
    '-- Plage nommée
    ActiveWorkbook.Names.Add Name:="MaListe", RefersTo:="=Feuil2!$B$2:$B$" & LastLg & ""
    '---------
    With [F2].Validation
        .Delete
        .Add Type:=xlValidateList, Formula1:="=MaListe"
        .IgnoreBlank = True
        .InCellDropdown = True
        '.InputTitle = ""
        '.ErrorTitle = ""
        '.InputMessage = ""
        '.ErrorMessage = ""
        '.ShowInput = True
        .ShowError = True
    End With
End Sub

J'aimerais pourquoi mon code en dessus, me donne parfois des dates sous format anglais, français ou avec en plus des heures et minutes ?

Merci d'avance.

**Bear the french** · 10/07/2012, 08h03

Bonjour,

La différence entre mon code et le tien = j'utilise une variable tableau VBA alors que tu as fait le choix de "coller tes résultats" en colonne B.

Premier problème : Ta solution est plus lente (enfin avec plus de données !) mais procure l'avantage d'être visuelle.

Deuxième problème : Je pense qu'Excel interprête le format de la cellule en fonction du contenu que l'on y stocke (voir historise le format)... Enfin, c'est une piste... Essaies d'avoir une colonne B au bon format en rajoutant un peu de code en fin de macro.

Bertrand

**apt** · 10/07/2012, 20h38

Bonsoir Bear the french,

Envoyé par Bear the french

Je pense qu'Excel interprête le format de la cellule en fonction du contenu que l'on y stocke (voir historise le format)...

Pourtant j'ai bien fait de formater les dates récupérées avant de les stockées dans la variable dic ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

fCel = Trim(Format(oCel.Value, "dd/mm/yyyy"))

**Bear the french** · 10/07/2012, 22h44

Bonsoir apt,

Remarque n°1 : Changes la partie "Récupérer les dates sans doublons" par ce code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
    '-- Récupérer les dates sans doublons
    For Each oCel In oPlg.Cells
        If Not dic.Exists(oCel) Then
            fCel = Format(oCel.Value, "m/d/yyyy")
            dic.Add fCel, fCel
        End If
    Next oCel

Les formats de dates attribués aux cellules dans Excel ne se traduisent pas tous de la même façon en VBA.
Ainsi, une cellule dont on définit le format en jj/mm/aa sous Excel est traduit en VBA par : NumberFormat = dd/mm/yy. Normal.
Tandis qu'un format défini par jj/mm/aaaa est traduit par : NumberFormat = m/d/yyyy, ce qui change tout. C'est bon à savoir

2ème remarque : Rajoute un + 1 après LastLg (recopie le code qui suit)... En commençant en B2 au lieu de B1, il te faut décaler ton tableau d'une cellule vers le bas.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ActiveWorkbook.Names.Add Name:="MaListe", RefersTo:="=Feuil2!$B$2:$B$" & LastLg + 1 & ""

Bertrand

**apt** · 11/07/2012, 03h19

Bonsoir Bertrand,

Envoyé par Bear the french

Les formats de dates attribués aux cellules dans Excel ne se traduisent pas tous de la même façon en VBA.
Ainsi, une cellule dont on définit le format en jj/mm/aa sous Excel est traduit en VBA par : NumberFormat = dd/mm/yy. Normal.
Tandis qu'un format défini par jj/mm/aaaa est traduit par : NumberFormat = m/d/yyyy, ce qui change tout. C'est bon à savoir

Je dirais même que c'est essentiel de le savoir

Dans la liste résultante, pourquoi il y a l’en-tête "Date" ?

**Bear the french** · 11/07/2012, 07h29

Envoyé par apt

Dans la liste résultante, pourquoi il y a l’en-tête "Date" ?

Bonjour,

Est ce que "Date" est dans la colonne A avant de lancer la macro ? Auquel cas il faudra supprimer sa ligne.

Si tu veux conserver Date en A1 et ne pas l'inclure dans ta macro, il faut changer :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set oPlg = .Range("A1:A" & LastLg)   'plage de données

par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set oPlg = .Range("A2:A" & LastLg)   'plage de données

(et attention de gérer les conséquences sur ta variable LastLg)

Bertrand

**apt** · 13/07/2012, 02h04

Bonsoir Bertrand,

J'ai corrigé, et "Date" n'est plus maintenant.

J'ai testé sur la liste de données suivante :

Date
10/05/2012 15:25
10/05/2012 15:25
10/05/2012 16:18
10/05/2012 16:18
10/05/2012 21:33
10/05/2012 21:33
15/05/2012 00:05
15/05/2012 09:48
15/05/2012 14:28
16/05/2012 11:24
16/05/2012 11:24
16/05/2012 11:24
16/05/2012 11:24
16/05/2012 11:24
16/05/2012 11:24
16/05/2012 11:24
16/05/2012 11:24
11/06/2012 01:24
16/06/2012 08:24
17/06/2012 10:30
17/06/2012 14:32
18/06/2012 08:17
19/06/2012 16:38

Et j'ai comme résultat ceci :

10/05/2012
15/05/2012
16/05/2012
11/06/2012
16/06/2012
17/06/2012
18/06/2012
19/06/2012
19/06/2012

Avec la dernière ligne doublonnée !

**Bear the french** · 13/07/2012, 20h25

Bonsoir,

Peux tu mettre ton code en ligne ? Ça sera plus facile.

Bertrand

**apt** · 15/07/2012, 14h58

Bonjour Bear the french,

Voila :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
Sub ListeDate()
    Dim i%, v$, dPlg, oCel As Range, oPlg As Range
    Dim dic As Object, LastLg As Integer
    Dim fCel As String
 
    Set dic = CreateObject("Scripting.Dictionary")
 
    With Sheets("feuil2")
        LastLg = .Range("A" & .Rows.Count).End(xlUp).Row
        'MsgBox "LastLg = " & LastLg
 
        Set oPlg = .Range("A1:A" & LastLg)   'plage de données
    End With
    dPlg = oPlg.Value
    On Error Resume Next
 
    '-- Récupérer les dates sans doublons
    For Each oCel In oPlg.Cells
        If Not dic.Exists(oCel) Then
            fCel = Format(oCel.Value, "m/d/yyyy")
            dic.Add fCel, fCel
        End If
    Next oCel
 
    oPlg.Value = dPlg
    Set oPlg = Nothing
    Erase dPlg
    On Error GoTo 0
    Sheets("feuil2").Range("B2").Resize(dic.Count, 1) = Application.Transpose(dic.keys)
 
    LastLg = Sheets("feuil2").[B65000].End(xlUp).Row
    'MsgBox "LastLg = " & LastLg
    '-- Plage nommée
    ActiveWorkbook.Names.Add Name:="MaListe", RefersTo:="=Feuil2!$B$2:$B$" & LastLg + 1 & ""
    '---------
    With [F2].Validation
        .Delete
        .Add Type:=xlValidateList, Formula1:="=MaListe"
        .IgnoreBlank = True
        .InCellDropdown = True
        .ShowError = True
    End With
    [F2].NumberFormat = "dd/mm/yyyy"
End Sub

**Bear the french** · 15/07/2012, 15h35

Bonjour apt,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
Sub ListeDate()
    Dim i%, v$, dPlg, oCel As Range, oPlg As Range
    Dim dic As Object, LastLg As Integer
    Dim fCel As String
 
    Set dic = CreateObject("Scripting.Dictionary")
 
    With Sheets("feuil2")
        LastLg = .Range("A" & .Rows.Count).End(xlUp).Row
        'MsgBox "LastLg = " & LastLg
 
        Set oPlg = .Range("A2:A" & LastLg)   'plage de données
    End With
    dPlg = oPlg.Value
    On Error Resume Next
 
    '-- Récupérer les dates sans doublons
    For Each oCel In oPlg.Cells
        If Not dic.Exists(oCel) Then
            fCel = Format(oCel.Value, "m/d/yyyy")
            dic.Add fCel, fCel
        End If
    Next oCel
 
    oPlg.Value = dPlg
    Set oPlg = Nothing
    Erase dPlg
    On Error GoTo 0
    Sheets("feuil2").Range("B2").Resize(dic.Count, 1) = Application.Transpose(dic.keys)
 
    LastLg = Sheets("feuil2").[B65000].End(xlUp).Row
    'MsgBox "LastLg = " & LastLg
    '-- Plage nommée
    ActiveWorkbook.Names.Add Name:="MaListe", RefersTo:="=Feuil2!$B$2:$B$" & LastLg & ""
    '---------
    With [F2].Validation
        .Delete
        .Add Type:=xlValidateList, Formula1:="=MaListe"
        .IgnoreBlank = True
        .InCellDropdown = True
        .ShowError = True
    End With
 
End Sub

2 modifications :

1 . Comme tu as le texte "date" en A1, ta plage commence en A2 :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set oPlg = .Range("A1:A" & LastLg)   'plage de données

devient

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set oPlg = .Range("A2:A" & LastLg)   'plage de données

2. comme tu redéfinis LastLg par rapport à la colonne B

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ActiveWorkbook.Names.Add Name:="MaListe", RefersTo:="=Feuil2!$B$2:$B$" & LastLg + 1 & ""

devient

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ActiveWorkbook.Names.Add Name:="MaListe", RefersTo:="=Feuil2!$B$2:$B$" & LastLg & ""

Chez moi, avec ce correctif, ça fonctionne.

Bertrand

Remplir une liste déroulante avec des dates seulement [XL-2007]

Macros et VBA Excel

Discussions similaires

Partager

Partager