Macro valeur entre deux dates

Le 14/10/2020 à 14:17

Bonjour,

J'ai un fichier récapitulatif de production avec une macro. Cette macro ouvre des fichiers de suivi pour récupérer différentes information.

J'aimerais ajouter à cette macro une fonction supplémentaire, il faudrait que je récupère la production réaliser entre deux date.

J'ai la formule suivante mais je ne sais pas comment l'ajouter à ma macro: =SOMMEPROD((Objectifs!B38:B49>='Synthese Projet'!AL2)*(Objectifs!B38:B49<='Synthese Projet'!AL3)*(Objectifs!D38:D49))

En colonne B il y a les dates

10fichier-de-suivi.xlsm (111.73 Ko)

En colonne D le nombre de produits réaliser par jour.

En cellule AL2 la date de début

En cellule AL3 la date de fin.

Je met en PJ les deux fichiers: Synthèse

7synthese.xlsm (123.94 Ko)

et fichier de suivi

Mot de passe de la macro: Lila

Merci d'avance pour votre aide.

Le 15/10/2020 à 08:58

Bonjour,

Pouvez-vous essayer ceci :

Dim ProdIntervalle as double
Dim fobj as worksheet, fsynt as worksheet

Set fobj = Sheets("Objectifs")
Set fsynt = Sheets("Synthese Projet")

ProdIntervalle = application.sumproduct((fobj.range("B38:B49")>=fsynt.range("AL2")) * _
(fobj.range("B38:B49")<=fsynt.range("AL3")) * fobj.range("D38:D49"))

Cdlt,

Le 15/10/2020 à 11:38
3GB a écrit :

Bonjour,

Pouvez-vous essayer ceci :

Dim ProdIntervalle as double
Dim fobj as worksheet, fsynt as worksheet

Set fobj = Sheets("Objectifs")
Set fsynt = Sheets("Synthese Projet")

ProdIntervalle = application.sumproduct((fobj.range("B38:B49")>=fsynt.range("AL2")) * _
(fobj.range("B38:B49")<=fsynt.range("AL3")) * fobj.range("D38:D49"))

Cdlt,

Bonjour,

Merci dans un premier temps pour ton aide.

Je viens d'ajouter la macro que tu m'as fourni a celle que j'avais déjà comme ceux ci. Mais cela ne fonction pas. Je ne sais pas si elle est bien placé.

ActiveWorkbook.Sheets("AVANCEMENT").Range("I13").Copy
fdep.Range("AG" & ln).PasteSpecial xlPasteValues
ActiveWorkbook.Sheets("AVANCEMENT").Range("B7").Copy
fdep.Range("AI" & ln).PasteSpecial xlPasteValues
ActiveWorkbook.Sheets("AVANCEMENT").Range("D12").Copy
fdep.Range("AJ" & ln).PasteSpecial xlPasteValues
classeur.Close False
Next ln
Dim ProdIntervalle As Double
Dim fobj As Worksheet, fsynt As Worksheet
Set fobj = Sheets("Objectifs")
Set fsynt = Sheets("Synthese Projet")

ProdIntervalle = Application.SumProduct((fobj.Range("B38:B49") >= fsynt.Range("AL2")) * _
(fobj.Range("B38:B49") <= fsynt.Range("AL3")) * fobj.Range("D38:D49"))
End Sub

Le 15/10/2020 à 16:48

Bonjour,

Pour que le code soit plus lisible, vous pouvez utilisez le logo avec les balises </> pour l'insérer dedans.

Il faudrait que j'ai la macro en entier pour juger.

Car pour l'instant, le code est peu compréhensible :

Sub benetop()

Dim classeur as workbook
Dim fdep as worksheet, favanc as worksheet, fobj As Worksheet, fsynt As Worksheet
Dim ProdIntervalle As Double

Set classeur = workbooks("???") '<<<<
Set fdep = Sheets("???") '<<<<<<<
Set favanc = ActiveWorkbook.Sheets("AVANCEMENT")
Set fobj = Sheets("Objectifs")
Set fsynt = Sheets("Synthese Projet")

With favanc
    .Range("I13").Copy
    fdep.Range("AG" & ln).PasteSpecial xlPasteValues
    .Range("B7").Copy
    fdep.Range("AI" & ln).PasteSpecial xlPasteValues
    .Range("D12").Copy
    fdep.Range("AJ" & ln).PasteSpecial xlPasteValues
End with

classeur.Close False
'Next ln '<<<< next sans for

ProdIntervalle = Application.SumProduct((fobj.Range("B38:B49") >= fsynt.Range("AL2")) * _
(fobj.Range("B38:B49") <= fsynt.Range("AL3")) * fobj.Range("D38:D49"))

End Sub

Et quant au problème de départ, la variable ProdIntervalle stocke bien une valeur suite au calcul (enfin normalement) mais c'est normal qu'il ne se passe rien car cette valeur n'est renvoyée dans aucune cellule du classeur.

Le 16/10/2020 à 07:06
3GB a écrit :

Bonjour,

Pour que le code soit plus lisible, vous pouvez utilisez le logo avec les balises </> pour l'insérer dedans.

Il faudrait que j'ai la macro en entier pour juger.

Car pour l'instant, le code est peu compréhensible :

Sub benetop()

Dim classeur as workbook
Dim fdep as worksheet, favanc as worksheet, fobj As Worksheet, fsynt As Worksheet
Dim ProdIntervalle As Double

Set classeur = workbooks("???") '<<<<
Set fdep = Sheets("???") '<<<<<<<
Set favanc = ActiveWorkbook.Sheets("AVANCEMENT")
Set fobj = Sheets("Objectifs")
Set fsynt = Sheets("Synthese Projet")

With favanc
    .Range("I13").Copy
    fdep.Range("AG" & ln).PasteSpecial xlPasteValues
    .Range("B7").Copy
    fdep.Range("AI" & ln).PasteSpecial xlPasteValues
    .Range("D12").Copy
    fdep.Range("AJ" & ln).PasteSpecial xlPasteValues
End with

classeur.Close False
'Next ln '<<<< next sans for

ProdIntervalle = Application.SumProduct((fobj.Range("B38:B49") >= fsynt.Range("AL2")) * _
(fobj.Range("B38:B49") <= fsynt.Range("AL3")) * fobj.Range("D38:D49"))

End Sub

Et quant au problème de départ, la variable ProdIntervalle stocke bien une valeur suite au calcul (enfin normalement) mais c'est normal qu'il ne se passe rien car cette valeur n'est renvoyée dans aucune cellule du classeur.

Bonjour,

la macro de départ est la suivante:

Option Explicit

Dim ln&, chemin, nomFichier, classeur, fdep As Worksheet

Sub ZoneTexte1_Cliquer()

Set fdep = ActiveSheet
For ln = 7 To Range("AH" & Rows.Count).End(xlUp).Row
chemin = Range("AH" & ln)
nomFichier = Dir(chemin & "*.xls*")
Set classeur = Workbooks.Open(chemin)
ActiveWorkbook.Sheets("AVANCEMENT").Range("B23").Copy
fdep.Range("C" & ln).PasteSpecial xlPasteValues
ActiveWorkbook.Sheets("AVANCEMENT").Range("B21").Copy
fdep.Range("F" & ln).PasteSpecial xlPasteValues
ActiveWorkbook.Sheets("AVANCEMENT").Range("B22").Copy
fdep.Range("I" & ln).PasteSpecial xlPasteValues
ActiveWorkbook.Sheets("AVANCEMENT").Range("B25").Copy
fdep.Range("J" & ln).PasteSpecial xlPasteValues
ActiveWorkbook.Sheets("AVANCEMENT").Range("B24").Copy
fdep.Range("K" & ln).PasteSpecial xlPasteValues
ActiveWorkbook.Sheets("AVANCEMENT").Range("B4").Copy
fdep.Range("Q" & ln).PasteSpecial xlPasteValues
ActiveWorkbook.Sheets("AVANCEMENT").Range("D8").Copy
fdep.Range("R" & ln).PasteSpecial xlPasteValues
ActiveWorkbook.Sheets("AVANCEMENT").Range("B4").Copy
fdep.Range("S" & ln).PasteSpecial xlPasteValues
ActiveWorkbook.Sheets("AVANCEMENT").Range("D9").Copy
fdep.Range("T" & ln).PasteSpecial xlPasteValues
ActiveWorkbook.Sheets("AVANCEMENT").Range("B4").Copy
fdep.Range("U" & ln).PasteSpecial xlPasteValues
ActiveWorkbook.Sheets("AVANCEMENT").Range("D10").Copy
fdep.Range("V" & ln).PasteSpecial xlPasteValues
ActiveWorkbook.Sheets("AVANCEMENT").Range("B5").Copy
fdep.Range("W" & ln).PasteSpecial xlPasteValues
ActiveWorkbook.Sheets("AVANCEMENT").Range("D11").Copy
fdep.Range("X" & ln).PasteSpecial xlPasteValues
ActiveWorkbook.Sheets("AVANCEMENT").Range("B6").Copy
fdep.Range("Y" & ln).PasteSpecial xlPasteValues
ActiveWorkbook.Sheets("AVANCEMENT").Range("D13").Copy
fdep.Range("Z" & ln).PasteSpecial xlPasteValues
ActiveWorkbook.Sheets("AVANCEMENT").Range("H9").Copy
fdep.Range("AA" & ln).PasteSpecial xlPasteValues
ActiveWorkbook.Sheets("AVANCEMENT").Range("H10").Copy
fdep.Range("AB" & ln).PasteSpecial xlPasteValues
ActiveWorkbook.Sheets("AVANCEMENT").Range("H12").Copy
fdep.Range("AC" & ln).PasteSpecial xlPasteValues
ActiveWorkbook.Sheets("AVANCEMENT").Range("I9").Copy
fdep.Range("AD" & ln).PasteSpecial xlPasteValues
ActiveWorkbook.Sheets("AVANCEMENT").Range("I10").Copy
fdep.Range("AE" & ln).PasteSpecial xlPasteValues
ActiveWorkbook.Sheets("AVANCEMENT").Range("I11").Copy
fdep.Range("AF" & ln).PasteSpecial xlPasteValues
ActiveWorkbook.Sheets("AVANCEMENT").Range("I13").Copy
fdep.Range("AG" & ln).PasteSpecial xlPasteValues
ActiveWorkbook.Sheets("AVANCEMENT").Range("B7").Copy
fdep.Range("AI" & ln).PasteSpecial xlPasteValues
ActiveWorkbook.Sheets("AVANCEMENT").Range("D12").Copy
fdep.Range("AJ" & ln).PasteSpecial xlPasteValues
classeur.Close False
Next ln
End Sub

A celle ci j'aimerais ajouter la macro que vous m'avez fournis, l'information recueilli doit renseigner la colonne K

merci pour votre aide.

Le 16/10/2020 à 10:33

Bonjour,

Je comprends pas tout malheureusement.

Je vois que la colonne K est déjà alimentée par la cellule B24 d'avancement.

Je comprends pas pourquoi cette boucle ? Sur toutes les lignes, vous recopiez les valeurs ?

Et la macro que je vous ai fourni n'est que la vôtre réorganisée (enfin un extrait) et placée sous les balises pour une lecture plus facile du code.

Le 16/10/2020 à 10:54
3GB a écrit :

Bonjour,

Je comprends pas tout malheureusement.

Je vois que la colonne K est déjà alimentée par la cellule B24 d'avancement.

Je comprends pas pourquoi cette boucle ? Sur toutes les lignes, vous recopiez les valeurs ?

Et la macro que je vous ai fourni n'est que la vôtre réorganisée (enfin un extrait) et placée sous les balises pour une lecture plus facile du code.

Je pense que l'on sait pas compris, j'ai du mal m'exprimé.

Dans mon fichier Suivi TEST il y a un onglet "Objectif" dans lequel on renseigne la production en colonne D, K, R, AE, AL ET AS face à des dates colonne B.

Dans mon fichier Synthèse je voudrais avoir la production (dans la colonne AK, AL, AM, AN, AO et AP) entre deux date (date que je renseigne en cellule AL2 et AL3)

8synthese.xlsm (36.85 Ko)

9fichier-suivi-test.zip (239.20 Ko)

Rechercher des sujets similaires à "macro valeur entre deux dates"