date vba

G

garrec

XLDnaute Occasionnel
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 :)

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
 
Trier par date Trier par votes
YANN-56

YANN-56

XLDnaute Barbatruc
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
 
Vote positif 0 Vote négatif
YANN-56

YANN-56

XLDnaute Barbatruc
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
 
Vote positif 0 Vote négatif
YANN-56

YANN-56

XLDnaute Barbatruc
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 ...:p)

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
 
Vote positif 0 Vote négatif
YANN-56

YANN-56

XLDnaute Barbatruc
Re : date vba

Bonsoir garrec,

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

Code: 
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
 

Pièces jointes

  • JEUDI_1.xls
    131 KB · Affichages: 50
Dernière édition:
Vote positif 0 Vote négatif
G

garrec

XLDnaute Occasionnel
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

Code: 
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
 
Vote positif 0 Vote négatif

Discussions similaires

E
  • Résolu(e)
Microsoft 365 Boucle sur lignes <>0
Réponses
2
Affichages
143
eric72
E
Dadi147
  • Question
XL 2019 Sélectionner automatiquement la dernière colonne contenant des données - 2 colonnes Précédent
Réponses
11
Affichages
438
Staple1600
Staple1600
T
  • Question
XL 2019 VBA: Effacer le contenu de plages de cellules avec critères
Réponses
5
Affichages
1 K
tiitii60
T
B
  • Résolu(e)
XL 2019 Format nombre dans un tableau à colonne et ligne variable
Réponses
6
Affichages
464
babie971
B
T
  • Question
XL 2021 message si une valeur n'existe pas
Réponses
6
Affichages
400
target
T
PORCHER
  • Question
Microsoft 365 L'indice n'appartient pas à la sélection
Réponses
8
Affichages
306
TooFatBoy
TooFatBoy
S
  • Question
Microsoft 365 créer un macro vba
Réponses
0
Affichages
143
souhaib ad
S
A
  • Résolu(e)
Microsoft 365 Correction du code vba
Réponses
5
Affichages
172
AD95
A
D
  • Question
XL 2010 Identification d'une cellule cliquée
Réponses
6
Affichages
330
dadu35
D
S
  • Question
XL 2021 macro VBA excel
Réponses
1
Affichages
164
crocrocro
C

Membres actuellement en ligne

8 membres et 100 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 163
Messages
2 085 861
Membres
103 006
dernier inscrit
blkevin