Copie cellules si date1<date<date2

Version imprimable

Bonjour à tous,

je débute en VB et je bloque sur quelque chose qui doit être relativement simple pour les esprits éclairés que vous êtes...
j'ai eu beau chercher et chercher encore, je n'ai rien trouver approchant ma recherche sur google(il parait que la solution se trouve souvent sur google ;)) quoique certain reconnaitront peut etre le début du code :oops:; voila :

pour le boulot, je dois créer une macro simplifiant ma tache, je m'explique :
j'ai plusieurs choix possible de date pour des prélèvements, que je répertorie en colonne i; et en fonction de la date de début et de la date de fin je voudrais copier//coller certaines cellules afin d'exporter sur une autre feuille les informations essentielles (en l'occurrence un num client, nom, montant etc...). Il me faut donc d'abord sélectionner tous ce qui concerne la date d'échéance (le 05, le 10, le 15, le 20 ou le 25 du mois) en colonne i, puis comparer les dates de début et de fin (colonnes E et F) par rapport à la date du jour (si le 5 du mois tombe un samedi ou un dimanche ça reporte au lundi...etc) :

En balbutiant j'arrive à :
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 Sub ech() Dim Plage As Range Dim dateDeb As Date Dim dateFin As Date Set Plage = Application.InputBox("Sélectionnez une plage", "notByMe", Type:=8) Dim Rechercheplage As String Rechercheplage = InputBox("Entrer la date d'echeance à rechercher", "...") If Rechercheplage = vbNullString Then Exit Sub Dim Cellule As Range For Each Cellule In Plage If InStr(1, Cellule.Value, Rechercheplage) > 0 Then Range(Cellule.Address).Select dateDeb = ActiveCell.Offset(0, -4) dateFin = ActiveCell.Offset(0, -3) If (dateDeb <= Date and dateFin>= date) Then ActiveCell.Offset(0, -7).Copy Destination:=ActiveCell.Offset(0, 1) End If End If Next Cellule End Sub
la ligne: ActiveCell.Offset(0, -7).Copy Destination:=ActiveCell.Offset(0, 1) est un exemple de copier//coller qui me permet de savoir si, en fonction des "dateDeb et DateFin", mon code fonctionne... et bien sur non!

Je pense avoir un probleme de format de date, mais ça doit (très certainement) être un problème parmis tant d'autres... :cry:

un peu d'aide svp
Merci :P

19/06/2012, 12h02
L'Albatros

Quel est le message d'erreur que te renvoie Excel ?
A quelle ligne est-ce-que ça plante ?
19/06/2012, 12h54
zealot37

Bonjour l'Albatros

en fait ça fonctionne...
le problème est que quand dateDeb est, par ex, le 01/07/12 (et donc date est la date du jour...) et bien la copie se fait quand même.
En revanche avec dateFin cela fonctionne. si datefin est le 31/05/12 la copie ne se fait pas...

j'avoue ne pas comprendre, d'ou ma question sur le format de date...

Je pense avoir eu à peu près le même problème, et grace aux membres du forum je suis passé par un filtre :

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
Option Explicit
 
Private Sub CommandButton1_Click()
'Sub Init_LstCpt()
 
    Dim DateDebut As Date
    Dim DateFin As Date
    Dim WS1 As Worksheet
    Dim WS2 As Worksheet
    Dim k As Integer
    Dim Total1 As Double
    Dim Total2 As Double
    Dim Total3 As Double
    Dim Total4 As Double
 
    Set WS1 = ThisWorkbook.Worksheets("Feuil1")
    Set WS2 = ThisWorkbook.Worksheets("Feuil2")
    WS2.Cells.ClearContents
 
      DateDebut = TextBox1     
      DateFin = TextBox2 
 
 
    With WS1
 
        .Cells(1, 1).AutoFilter Field:=2, Criteria1:="<=" & CDec(DateFin), _
            Operator:=xlAnd, Criteria2:=">=" & CDec(DateDebut)
        On Error GoTo 1
        .Cells(1, 1).CurrentRegion.Copy Destination:=WS2.Cells(1, 1)
        On Error GoTo 0
    End With
 
 
 
    With WS2
 
        k = .Cells(.Rows.Count, 1).End(xlUp).Row
        If k < 2 Then
            MsgBox "Aucun resultat"
            GoTo 1
        End If
        Total1 = WorksheetFunction.Sum(.Range(.Cells(2, 3), .Cells(k, 3)))
        Cells(6, 9).Select
    ActiveCell.Value = Total1 / k
        Total2 = WorksheetFunction.Sum(.Range(.Cells(2, 4), .Cells(k, 4)))
        Cells(7, 9).Select
    ActiveCell.Value = Total2 / k
        Total3 = WorksheetFunction.Sum(.Range(.Cells(2, 5), .Cells(k, 5)))
        Cells(8, 9).Select
    ActiveCell.Value = Total3 / k
        Total4 = WorksheetFunction.Sum(.Range(.Cells(2, 6), .Cells(k, 6)))
        Cells(9, 9).Select
    ActiveCell.Value = Total4 / k
    End With
 
1
    WS1.Cells(1, 1).AutoFilter    
 
End Sub

Dans mon cas, je moyennais les cellules de quatres colonnes (une à une)correspondant à l'intervalle de dates renseigné dans les 2 TextBox.

Je sais pas si ça a bien répondu à ta question, mais ça permet de selectionner un jour précis sur un plage de date.

A +

19/06/2012, 13h33
zealot37

Bonjour titibou,

ça répond peut-être à mon problème, mais je ne vois pas trop comment m'y prendre.
je m'explique :
je dois gérer près de 2000 lignes (clients), et en colonne E et F j'ai toutes mes dates début et dates fin.
Je ne peux pas rentrer pour chaque ligne les deux dates dans les textbox, sinon je perdrai plus de temps que je n'en gagnerai...

Je n'ai peut être pas tout compris :oops:
19/06/2012, 16h12
titibou

J'ai du mal comprendre... Dans ce cas cela n'est peut être pas le mieux.
Moi j'ai une colonne avec les dates qui défilent, répétées ou pas, et les données correspondantes dans les colonnes juxtaposées.
Je pensais que tu voulais Selectionner des jours particuliers, et retrouver les actions commencées ou terminées à ce moment.

j'avoue débuter en macro et du coup je fais compliqué au lieu de faire simple

j'ai en colonne i la date d'échéance définie par "AU 05" ou "AU 10" etc...
en colonne E et F j'ai la date de prélèvement réelle mais il n'y a que le mois qui me sert (vu que la colonne i définie si c'est au 5 du mois, au 10 du mois etc)

du coup j'ai besoin de selectionner tous ce qui est "AU 05", et ensuite comparer les mois de début et de fin par rapport au mois en cours pour copier//coller les données dont j'ai besoin pr préparer sur une autre feuille ce que j'envoi à la banque...

d'ou dans mon ébauche :
Code:

1 2 3 4 5 6 7 8 9 10 11 Set Plage = Application.InputBox("Sélectionnez une plage", "notByMe", Type:=8) Dim Rechercheplage As String Rechercheplage = InputBox("Entrer la date d'echeance à rechercher", "...") If Rechercheplage = vbNullString Then Exit Sub Dim Cellule As Range For Each Cellule In Plage If InStr(1, Cellule.Value, Rechercheplage) > 0 Then Range(Cellule.Address).Select
afin de trouver tous ce qui est "AU 05" en colonne i (via l'inputbox)
et c'est au moment de comparer les mois (en E et F) que j'ai un problème...

Bonjour,

J'ai fait le test avec ce bout de code et je n'ai constaté aucun problème particulier.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub Test()
Dim DateDeb As Date, DateFin As Date
Dim Cellule As Range, Plage As Range
Dim Rechercheplage As String
    Set Plage = Application.InputBox("Sélectionnez une plage", "notByMe", Type:=8)
    Rechercheplage = InputBox("Entrer la date d'echeance à rechercher", "...")
    If Rechercheplage = vbNullString Then Exit Sub
        For Each Cellule In Plage
            If InStr(1, Cellule.Value, Rechercheplage) > 0 Then
                Range(Cellule.Address).Select
                DateDeb = ActiveCell.Offset(0, -4)
                DateFin = ActiveCell.Offset(0, -3)
                If (DateDeb <= Date And DateFin >= Date) Then
                    ActiveCell.Offset(0, -7).Copy Destination:=ActiveCell.Offset(0, 1)
                End If
            End If
        Next
End Sub

Cordialement.

20/06/2012, 21h40
zealot37

Merci gFZT82

la bonne nouvelle, je suis pas si mauvais :ccool:
la mauvaise, et bien ça ne fonctionne pas 8O

Soyons positifs... je reviens poster dès que j'ai résolu mon problème :mrgreen:
20/06/2012, 22h09
zealot37

vba applique un format "as date"

Y a t-il un format de date particulier à appliquer à mes colonnes E et F ?
21/06/2012, 00h06
gFZT82

L’erreur que tu constates peut provenir d’une interprétation de la date au format US, la date du 01/07/2012 étant alors interprétée 07/01/2012.

Tu as un bout de fichier à montrer (sans données confidentielles) ?

Cordialement.
21/06/2012, 08h29
zealot37

1 pièce(s) jointe(s)

Voici un petit extrait du fichier

J'ai essayé pas mal de format sans résultat... je m'y suis peut être mal pris :lol:
21/06/2012, 08h45
gFZT82

Bonjour,

Je viens de tester ton fichier avec le code que je t'ai transmis et j'obtiens un résultat correct, à savoir la copie du n° client 124 en J2.
Les cellules sont au bon format (date).

Tout semble OK :koi:

Cordialement.
21/06/2012, 09h45
zealot37

je suis perplexe... ça fonctionne au boulot et pas chez moi... paramètres régionaux ?
Je refais quand même un test chez moi ce soir et te dis si ça fonctionne...

Et... merci!!!:ccool:
21/06/2012, 22h43
zealot37

Bon finalement fonctionne aussi chez moi :ccool:

Merci encore !!!