IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Trouver les dates entre deux dates


Sujet :

Macros et VBA Excel

  1. #1
    Membre régulier
    Profil pro
    Inscrit en
    Mai 2008
    Messages
    235
    Détails du profil
    Informations personnelles :
    Localisation : France, Rhône (Rhône Alpes)

    Informations forums :
    Inscription : Mai 2008
    Messages : 235
    Points : 75
    Points
    75
    Par défaut Trouver les dates entre deux dates
    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 vba : 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
    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

  2. #2
    Membre émérite
    Profil pro
    Inscrit en
    Juillet 2007
    Messages
    2 130
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Juillet 2007
    Messages : 2 130
    Points : 2 443
    Points
    2 443
    Par défaut
    Salut lilp1 et le forum
    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+

  3. #3
    Membre régulier
    Profil pro
    Inscrit en
    Mai 2008
    Messages
    235
    Détails du profil
    Informations personnelles :
    Localisation : France, Rhône (Rhône Alpes)

    Informations forums :
    Inscription : Mai 2008
    Messages : 235
    Points : 75
    Points
    75
    Par défaut
    Voici ma maccro en integral, mais le reste n'est pas util, pour sa que j'avait poster juste cette partie :
    Code vba : 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
    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

  4. #4
    Membre émérite
    Profil pro
    Inscrit en
    Juillet 2007
    Messages
    2 130
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Juillet 2007
    Messages : 2 130
    Points : 2 443
    Points
    2 443
    Par défaut
    Salut lilp1 et le forum
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
     If date1 <> "" Or date2 <> "" Then
    revient à
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
     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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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+

  5. #5
    Membre régulier
    Profil pro
    Inscrit en
    Mai 2008
    Messages
    235
    Détails du profil
    Informations personnelles :
    Localisation : France, Rhône (Rhône Alpes)

    Informations forums :
    Inscription : Mai 2008
    Messages : 235
    Points : 75
    Points
    75
    Par défaut
    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.

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Calculer les jours entre deux dates
    Par Daniela dans le forum SQL
    Réponses: 4
    Dernier message: 09/10/2008, 17h01
  2. Réponses: 2
    Dernier message: 25/02/2008, 23h40
  3. Chercher les dimanches entre deux dates !
    Par sablito dans le forum Requêtes
    Réponses: 1
    Dernier message: 25/12/2007, 22h05
  4. [Dates] Les mois entre deux dates
    Par kagura dans le forum Langage
    Réponses: 2
    Dernier message: 28/06/2006, 11h38
  5. [VB6]sortir toutes les dates entre deux dates
    Par AlfiQue dans le forum VB 6 et antérieur
    Réponses: 9
    Dernier message: 20/02/2006, 19h09

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo