date vba

[garrec]

Bonjour

j'ai un code ci dessous qui me permet de rappatrier des données d'un onglets a l'autre. La condition majeure est que la date sous inférieur ou égale à une semaine. Voici le code 🙂

Sub Macro1()
 Dim ad As Range 'déclare la variable ad (Anciennes Données)
 Dim dl As Integer 'déclare la variable dl (Dernière Ligne)
 Dim pl As Range 'déclare la variable pl (PLage)
 Dim cel As Range 'déclare la variable cel (CELlule)
 Dim dest As Range 'déclare la variable dest (cellule de DESTination)
 Dim cl As Workbook
 Dim da As Date
 
Set cl = Workbooks("KARA_VIEW_GP.xls")
 Set ad = Sheets("Port MOMENTUM").Range("A31").CurrentRegion 'définit la plage des anciennes données
 With cl.Sheets("Daily Equity")  'prend en compte l'onglet "Daily Equity"
     'dl = .Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée de la colonne A
     Set pl = .Range("A2:A15000") 'définit la plage pl
 End With 'fin de la prise en compte de l'onglet "Daily Equity"
 For Each cel In pl 'boucle sur toutes les cellule cel de la plage pl
     'condition : si la date correspond et si en B il y a "Momentum"
     da = Format(Day(cel.Value), "00") & "/" & Format(Month(cel.Value), "00") & "/" & Format(Year(cel.Value), "0000")
     If da <= Date And da > Date - 7 And cel.Offset(0, 1).Value = "Momentum" Then
         'définit la cellle de destination
         Set dest = IIf(Sheets("Port MOMENTUM").Range("A31") = "", Sheets("Port MOMENTUM").Range("A31"), Sheets("Port MOMENTUM").Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0))
         dest.Value = cel.Value 'récupère la date
         dest.Offset(0, 1).Value = cel.Offset(0, 4).Value 'récupère le code isin
         dest.Offset(0, 2).Value = cel.Offset(0, 3).Value 'reçupère le nom de la valeur
         dest.Offset(0, 3).Value = cel.Offset(0, 12).Value 'récupère la devise
         dest.Offset(0, 4).Value = cel.Offset(0, 36).Value 'récupère la quantité
         dest.Offset(0, 5).Value = cel.Offset(0, 6).Value 'récupère le sens
         dest.Offset(0, 6).Value = cel.Offset(0, 15).Value 'récupère le cours
     End If 'fin de la condition
 Next cel 'prochaine celllule de la boucle
 End Sub

J'aimerais bien le modifier pour qu'il ne prenne plus les données dans le premiere onglets qui ont une date inférieur ou égale a J-7 mais qui ont une date inférieure ou égale au jeudi de la semain d'avant 🙂


C'est possible??


Merci d'avance. Un fichier serait-il nécessaire dans ce cas vous n'avez cas demander 🙂


Garrec

 

[YANN-56]

Re : date vba

Bonjour garrec, et à ceux qui passeront par ici,

Je n'ai pas vu de localisation dans ton profil,
mais la consonance Bretonne m'a interpelé.

A première vue, ta gestion des dates me semble inutilement complexe.

Si tu veux bien joindre un Fichier,
(Sans les éventuelles fioritures n'apportant rien au sujet)
je pourrais peut-être te proposer quelque chose.

Amicalement,

Yann

 

[garrec]

Re : date vba

Oui je suis breton!

Voila le fichier demandé. Si tu veux d'autres renseignements hésites pas a demander


Merci d'avance

Cdt

 

[YANN-56]

Re : date vba

Re garrec, (J'ai failli dire "Le Garrec" 🙂)

Ton Fichier est sur mon ordi, et je vais regarder.

Comme je l'avais soupçonné, les simplifications sont évidentes.
J'espère trouver le temps de te construire un exemple ce soir.

A plus tard,

Amicalement,

Yann

 

[garrec]

Re : date vba

Bonjour!

Merci Yann. J'attend avec impatience ce code alors 🙂


Tu es d'ou en bretagne?

Cdt

Merci encore

 

[YANN-56]

Re : date vba

Bonjour garrec,

Je suis vraiment désolé, mais hier soir, je n'avais pas vraiment la tête à faire du VBA.
(C'est rare, mais cela arrive ...😛)

Je ne vais pas être beaucoup chez moi cet après-midi,
mais promis en soirée, tu auras ma version.

En attendant, tu pourras jeter un œil sur mon fichier ici:
http://www.excel-downloads.com/forum/186514-userform-calendrier-avec-jours-feries-sans-api-ni-dtpicker-5.html#post1169457

Il manipule beaucoup les dates, et certains morceaux de codes devraient pouvoir servir dans ton cas.

Par ailleurs, pour répondre à ta question, tu as ma localisation dans mon profil: NOSTANG
Entre Lorient et Auray, à l'extrémité de la ria d'Etel.

Amicalement, et à ce soir,

Yann

 

[garrec]

Re : date vba

Bonjour yann

Marant ton agenda!!

j'attend activement ta version en soirée alors!

Bonne journée

amicalement

 

[YANN-56]

Re : date vba

Bonsoir garrec,

Voici mon idée pour simplifier ton code: Fichier joint.

Private Sub CommandButton1_Click()
Worksheets("RECAP").Activate ' Choix de la Feuille de Rédaction
For i = 2 To Worksheets("Daily Equity").Range("A65536").End(xlUp).Row ' "2" Pour éviter l'entête
If Worksheets("Daily Equity").Cells(i, 2).Value = "Momentum" Then 'Récupération du choix ""Momentum"
 'En partant de la date écrite dans la Cellule A1 de la Feuille ACCUEIL (A adapter par ailleurs)
   If CDbl(CDate(Worksheets("Daily Equity").Cells(i, 1).Value)) < CDbl(CDate(Worksheets("ACCUEIL").Cells(1, 1).Value) - 7) Then
    ' Le "-7" correspond au laps de temps d'une semaine
     L = L + 1 ' Choix de la Ligne à partir de laquelle écrire.
       With ActiveSheet
        .Cells(L, 1).Value = Weekday(Worksheets("Daily Equity").Cells(i, 1).Value - 1) '(-1) Pour norme Française
        .Cells(L, 2).Value = Format(CDate(Worksheets("Daily Equity").Cells(i, 1).Value), "dddd") ' Pour vérif
          For j = 1 To 19 '(Colonne "S")
          .Cells(L, j + 2).Value = Worksheets("Daily Equity").Cells(i, j).Value
          Next j
       End With
End If
End If
Next i
End Sub

Je me suis arrêté à la méthode, car ta base étant bien spécifique,
je te laisse le soin d'adapter à tes besoins.

La Feuille "ACCUEIL" n'est là que pour porter le Bouton moteur.
La Feuille "RECAP" n'est là que pour constater le résultat.
(Cette dernière peut être construite de la même façon que ta Feuille réceptrice)

Dans mon procédé, je charge tout pour simplifier....
Ce qui est inutile pour la lecture peut être caché dans des colonnes masquées.

La valeur numérique du jour, ainsi que son nom lisible ne sont qu'une information qui permet
de vérifier le bon fonctionnement. (A supprimer par la suite)

L'idée principale est l'utilisation seule des valeurs numérique des dates,
et d'éviter les "Offset" fastidieux.

Tu regarde, et tu me dis,

Amicalement, et au plaisir,

Yann

 

[garrec]

Re : date vba

Bonjour

Oups là j'avoue c'est de ma faute!! Je n'avais pas vu ta réponse!! Merci bcp

Regarde ce que j'ai fais

Sub Macro4()


Dim cel As Range 'déclare la variable cel (CELlule)
 Dim dest As Range 'déclare la variable dest (cellule de DESTination)
 Dim cl As Workbook
 Dim da As Date
 Dim Jour As Byte, Ecart As Byte
 
Set cl = Workbooks("KARA_VIEW_GP.xls")
 Set ad = Sheets("Port_Heritage").Range("D4").CurrentRegion 'définit la plage des anciennes données
 
 With cl.Sheets("Daily Equity")  'prend en compte l'onglet "Daily Equity"
     'dl = .Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée de la colonne A
     Set pl = .Range("A2:A15000") 'définit la plage pl
 End With 'fin de la prise en compte de l'onglet "Daily Equity"
 
 Jour = Weekday(Date, 2)
If Jour < 5 Then Ecart = Jour + 3 Else Ecart = Jour - 4
 For Each cel In pl 'boucle sur toutes les cellule cel de la plage pl
     'condition : si la date correspond et si en B il y a "Momentum"
     da = Format(Day(cel.Value), "00") & "/" & Format(Month(cel.Value), "00") & "/" & Format(Year(cel.Value), "0000")
   If da <= Date And da >= (Date - Ecart) And cel.Offset(0, 1).Value = "HERITAGE" Then
         'définit la celulle de destination
          Set dest = IIf(Sheets("Port_Heritage").Range("D4") = "", Sheets("Port_Heritage").Range("D4"), Sheets("Port_Heritage").Cells(Application.Rows.Count, 4).End(xlUp).Offset(1, 0))
         dest.Value = cel.Value 'récupère la date
         dest.Offset(0, 1).Value = cel.Offset(0, 4).Value 'récupère le code isin
         dest.Offset(0, 2).Value = cel.Offset(0, 3).Value 'reçupère le nom de la valeur
         dest.Offset(0, 3).Value = cel.Offset(0, 12).Value 'récupère la devise
         dest.Offset(0, 4).Value = cel.Offset(0, 36).Value 'récupère la quantité
         dest.Offset(0, 5).Value = cel.Offset(0, 6).Value 'récupère le sens
         dest.Offset(0, 6).Value = cel.Offset(0, 15).Value 'récupère le cours
     End If 'fin de la condition
 Next cel 'prochaine celllule de la boucle
 End Sub

Mais je n'avais pas vu ta réponse aussi!

Mais j'avoue que ton idée semble interressante a essayer aussi

Have a good day