Trouver les dates entre deux dates

Version imprimable

Re bonjour, oui je sait, je poste bcp, mais je voit que je progresse, j'arrive a trouver quelque solution seul maintenant, bien qu'il faille m'indiquer un peut la route a suivre :)
Bon voila mon nouveau probleme, j'ai une feuille excel ou je peut rentrer deux dates, et j'aimerais pouvoir ( on est toujours dans le mm cas que tout mes autres postes) trouver toutes les dates entre ces deux dates pour ensuite copier les lignes ou ces dates sont présentes.
Si qqn aurrait un exemple d'algo, voici mon code actuel :

Code:

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
Set date1 = .Range("H10")
    Set date2 = .Range("K10")
    End With
    Workbooks(nomfichier).Activate
    With Sheets(nomfeuille)
    Range("B:B").NumberFormat = "ddmmyyyy"
    dl = .Range("a" & Rows.Count).End(xlUp).Row
    Set a = .Range("B1:B" & dl).Find(date1)
    Set c = .Range("A1:A" & dl).Find(nomjournal)
    'Set b = .Range("B1:B" & dl).Find(date2)
    If date1 <> "" Or date2 <> "" Then
        Sheets.Add After:=Worksheets(Worksheets.Count)
        ActiveSheet.Name = "Ecriture"
        irow = 0
        irow2 = 1
        firstaddress = a.Address
        For x = 1 To dl - 1
            irow = irow + 1
            'Emepeche le rafraichissement de l'écran, pour ne pas voir le traitement
            Application.ScreenUpdating = False
                Worksheets(nomfeuille).Select
                If c <> "***" Then
                    'copie des lignes concerner
                    Sheets("Ecriture").Cells(irow2, 1).Columns("A:BP").Value = c.EntireRow.Value
                    irow2 = irow2 + 1
                    Sheets("Ecriture").Select
                End If
            Set a = .Range("b1:b" & dl).FindNext(a)
            Set c = .Range("A" & c.Row, "A" & dl).Find(nomjournal)
            If a Is Nothing Or a.Address = firstaddress Then
                Exit For
            End If
        Next x

Simplement, il ne me copie que les lignes ou est présentes la date1

28/05/2009, 14h10
Gorfael

Salut lilp1 et le forum

Citation:

Personne n'aurrait une petite idée d'algo pour palier a ce pbrs? ou un bon de code, ou une idée?

si, mais première question :
- Faut-il mieux prendre du temps pour rédiger un sujet compréhensible pour quelqu'un d'extérieur au problème ou le perdre en postant des précisions ou en faisant des up ?

- Pourquoi mettre un extrait de ta macro, alors que la totalité pourrait peut-être nous aider à répondre ?

- réellement, avec les infos de ton sujet, j'ai pas envie de me creuser la tête pour le comprendre. Une petite suggestion : essaies d'utiliser les filtres automatiques avec >=Date1 et <=Date2 (en admettant que tu recherches Date1<=lignes<=Date2)
A+

Voici ma maccro en integral, mais le reste n'est pas util, pour sa que j'avait poster juste cette partie :

Code:

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
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
Sub OuvrirLeFichier()
Dim nomfeuille As String, Ligne As Long, fichier1 As String, texte As String, _
tableau() As Long, i As Long, compteur As Long, a As Range, x As Long, dl As Long, ir As Long, _
firstaddress As String, nomfeuille1 As String, nomjournal As String, irow As Long, ouvert As Boolean, _
nomfichier As String, irow2 As Long, date1 As Range, date2 As Range, b As Range, c As Range, date3 As Range
ouvert = 0
    '2 = Texte
    '1 = Montant
    '4 = Date
    Workbooks.OpenText Filename:=LeFichierAOuvrir, FieldInfo:=Array( _
        Array(0, 2), Array(3, 4), Array(11, 2), Array(13, 2), Array(30, 2), Array(31, 2), _
        Array(48, 2), Array(83, 2), Array(118, 2), Array(121, 4), Array(129, 2), Array(130, 1), _
        Array(150, 2), Array(151, 2), Array(159, 2), Array(162, 2), Array(172, 2), Array(175, 2), _
        Array(195, 2), Array(215, 2), Array(218, 2), Array(220, 2), Array(222, 2), Array(257, 4), _
        Array(265, 4), Array(273, 2), Array(276, 2), Array(293, 4), Array(301, 2), Array(304, 2), _
        Array(324, 2), Array(344, 2), Array(347, 2), Array(350, 2), Array(385, 2), Array(386, 2), _
        Array(389, 2), Array(392, 2), Array(395, 2), Array(412, 2), Array(429, 2), Array(446, 4), _
        Array(454, 4), Array(462, 4), Array(470, 2), Array(505, 9), Array(515, 2), Array(532, 2), _
        Array(562, 2), Array(592, 2), Array(622, 2), Array(652, 2), Array(682, 2), Array(712, 2), _
        Array(742, 2), Array(772, 2), Array(802, 2), Array(832, 2), Array(835, 2), Array(838, 2), _
        Array(841, 2), Array(844, 2), Array(864, 2), Array(884, 2), Array(904, 2), Array(924, 2), _
        Array(932, 2), Array(933, 2), Array(934, 2), Array(937, 2), Array(957, 2), Array(977, 2), _
        Array(997, 2), Array(1005, 2), Array(1013, 2), Array(1018, 2), Array(1019, 2), Array(1020, 2), _
        Array(1023, 2), Array(1040, 2), Array(1057, 2), Array(1074, 2), Array(1091, 2), Array(1126, 2), _
        Array(1129, 2), Array(1139, 2), Array(1142, 2), Array(1159, 2), Array(1176, 2), Array(1177, 2), _
        Array(1185, 2), Array(1193, 2), Array(1201, 2), Array(1236, 2), Array(1237, 2), Array(1238, 2), _
        Array(1241, 2), Array(1249, 2), Array(1266, 2), Array(1269, 2), Array(1277, 2), Array(1280, 2))
ouvert = 1  'si le fichier est ouvert sous forme de classeur XLS
    Range("B:B,J:J,X:X,Y:Y,AB:AB,AP:AP,AQ:AQ,AR:AR").NumberFormat = "ddmmyyyy"
    With Range("L:L,R:R,S:S,BJ:BJ,BK:BK,BL:BL,BM:BM")
        .HorizontalAlignment = xlRight
        .NumberFormat = "0.00"
    End With
    'enregistrement du nom de la feuille active dans une variable
    nomfeuille = ActiveSheet.Name
    nomfichier = ActiveWorkbook.Name
    'recherche de la valeur '***' dans la colonne 'a'
    nomjournal = "***"
    Workbooks(classeur).Activate
    With Sheets(nomfeuil)
    Set date1 = .Range("H10")
    Set date2 = .Range("K10")
    End With
    Workbooks(nomfichier).Activate
    With Sheets(nomfeuille)
    Range("B:B").NumberFormat = "ddmmyyyy"
    dl = .Range("a" & Rows.Count).End(xlUp).Row
    Set a = .Range("B1:B" & dl).Find(date1)
    'Set b = .Range("B1:B" & dl).Find(date2)
    Set c = .Range("A1:A" & dl).Find(nomjournal)
    If date1 <> "" Or date2 <> "" Then
        Sheets.Add After:=Worksheets(Worksheets.Count)
        ActiveSheet.Name = "Ecriture"
        irow = 0
        irow2 = 1
        firstaddress = a.Address
        For x = 1 To dl - 1
            irow = irow + 1
            'Emepeche le rafraichissement de l'écran, pour ne pas voir le traitement
            Application.ScreenUpdating = False
                Worksheets(nomfeuille).Select
                    If Not a Is Nothing And c <> "***" Then
                        'copie des lignes concerner
                        Sheets("Ecriture").Cells(irow2, 1).Columns("A:BP").Value = c.EntireRow.Value
                        irow2 = irow2 + 1
                        Sheets("Ecriture").Select
                    End If
            Set a = .Range("b1:b" & dl).FindNext(a)
            'Set b = .Range("b1:b" & dl).FindNext(b)
            Set c = .Range("A" & c.Row, "A" & dl).Find(nomjournal)
            If a Is Nothing Or a.Address = firstaddress Then
                Exit For
            End If
        Next x
    Else
        Set c = .Range("A1:A" & dl).Find(nomjournal)
        Sheets.Add After:=Worksheets(Worksheets.Count)
        ActiveSheet.Name = "Ecriture"
        irow = 0
        irow2 = 1
        For x = 1 To dl - 1
            irow = irow + 1
            'Emepeche le rafraichissement de l'écran, pour ne pas voir le traitement
            Application.ScreenUpdating = False
            If c <> "***" Then
                'création d'une nouvelle feuille et on l'a renomme
                firstaddress = c.Address
                'copie des lignes concerner
                Sheets("Ecriture").Cells(irow2, 1).Columns("A:BP").Value = c.EntireRow.Value
                irow2 = irow2 + 1
                Sheets("Ecriture").Select
            End If
            Set c = .Range("A" & c.Row, "A" & dl).Find(nomjournal)
        Next x
    End If
    Call LigneChampsEcrGen
    End With
    'copie de la feuille du nouveau classeur dans l'ancien et suppresion du nouveau
    Application.DisplayAlerts = False
    Sheets("Ecriture").Select
    Sheets("Ecriture").Copy After:=Workbooks("Essai.xls").Sheets(1)
    Windows(nomfichier).Close
    Windows("Essai.xls").Activate
    Exit Sub
End Sub

Jpensais que mon explication était clair, j'ai un fichier texte que j'importe dans un classeur, ensuite, j'ai deux variables date1 et date2 sui sont complétés grace a une cellule d'un autre classeur, et j'aimerais trouver toutes les lignes sur mon classeur ou j'ai importer mon fichier texte ou sont présentes les dates qui sont comprises entre date1 et date2.
VOila j'espere avoir été plus clair

Salut lilp1 et le forum

Citation:

Jpensais que mon explication était clair

Si personne ne répond, c'est que soit le forum te boude, soit il est incapable de te répondre, parce la réponse est trop compliquée (et sur le forum, il y en a qui sont sacrément balèzes, alors ça m'étonnerait) ou par ce que c'est la question qui est incompréhensible.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 With Sheets(nomfeuil) Set date1 = .Range("H10") Set date2 = .Range("K10") End With Workbooks(nomfichier).Activate With Sheets(nomfeuille) Range("B:B").NumberFormat = "ddmmyyyy" dl = .Range("a" & Rows.Count).End(xlUp).Row Set a = .Range("B1:B" & dl).Find(date1) 'Set b = .Range("B1:B" & dl).Find(date2) Set c = .Range("A1:A" & dl).Find(nomjournal) If date1 <> "" Or date2 <> "" Then
J'ai demandé la macro en entier, parce que l'explication que se trouvait me semblait débile : Date2 = Sheets(nomfeuil).[K10]
donc ton test

Code:

If date1 <> "" Or date2 <> "" Then

revient à

Code:

If date1 <> "" Or Sheets(nomfeuil).[K10] <> "" Then

et je ne vois aucun traitement sur Date2.

De plus, comme tous programmateurs émérites, je vois que tu t'affranchis des informations d'Excel :
Code:

1 2 Application.ScreenUpdating = False Application.DisplayAlerts = False
Je ne vois pas la remise à True

Je ne comprends pas ce que tu veux faire : pour moi (pas pour toi j'espère) ton algorythme n'est pas clair : tu utilises une méthode .Find en cascade et comme je ne connais pas l'organisation des données, je vois pas la corrélations entre Date1, Date2 et Monjournal (même avec explication et macro). Tu mets un "Exit sub", juste à la ligne avant "End sub".

Moi, je pense que pour traiter des cas comme ça (multicritères pour ce que je crois comprendre), j'utiliserais des filtres automatiques.
A+

28/05/2009, 16h05
lilp1

Effectivement, je n'utilise pas encore 'date2', mais le test : If date1 <> "" Or date2 <> "" Then n'est pas genant si date2 n'est pas renseigner puisqu'il y a un 'or'.
J'ai joint mon document complet.
Ben en réalité, je fait mon projet étapes par étapes, mais en gros, j'aimerais que quand on clik sur 'ecriture' on puisse saisir 2dates dans les tableaux dessous, et que la maccro, aille cherche dans un fichier texte, les lignes qui concernent les ecritures (cette partie fonctionne) et ne copie que les lignes ou les dates sont entre les 2 dates rentrer sur la maccro. VOila pourquoi j'ai date1 et date2.
Si tu a besoin de plus de précision sa serait ac plaisir, et dsl si je ne suis pas assez clair quand je pose mes questions, pourtant j'essaye de l'etre.