macro sur intervalle de date

T

tracor

Guest
bonjour le forum

est il possible de créer un macro permettant de choisir un intervalle entre 2 dates afin de compter le nombre de valeurs à l'intérieur de cet intervalle
cet intervalle est dans un tableau et il varie suivant l'intitulé des colonnes
ex
du 01/07/04 au 10/07/04
qté = 10

merci d'avance

tracor
 
@

@+Thierry

Guest
Bonjour Tracor, le Forum

Imaginons en Feuille "Sheet1" en B1 la Date de Départ (inclusive) et en B2 la Date d'Arrivée... En Feuille "Sheet2" dans la colonne "A" les valeurs Dates à scanner...

Voici ce que çà donnerait par VBA :

Option Explicit

Sub CountDateFromTo()
Dim DateFrom As Date
Dim DateTo As Date
Dim Tableau As Variant
Dim DateInclusiveCount As Integer, i As Integer

With Sheets("Sheet1")
DateFrom = .Range("B1")
DateTo = .Range("B2")
End With

Tableau = Sheets("Sheet2").Range("A1:A1000") 'à adapter ...

For i = 1 To UBound(Tableau)
If Tableau(i, 1) >= DateFrom And Tableau(i, 1) <= DateTo Then
DateInclusiveCount = DateInclusiveCount + 1
End If
Next i

MsgBox DateInclusiveCount & " entrées sont incluses entre " & DateFrom & " et " & DateTo

End Sub

Bon Après Midi
@+Thierry
 
T

tracor

Guest
salut thierry

je souhaiterai plutôt que le résultat s'affiche dans une cellule

et malheureusement
j'ai un tableau qui est très important et j'ai une erreur qui m'indique
"dépassement de capacité" à la ligne
for i=1 to ubound(tableau)
comment y remédier

merci d'avance

tracor
 
@

@+Thierry

Guest
Re Bonjour Tracor, le Forum

Alors qu'à celà ne tienne .... Là il n'y a de limite que la feuille Excel elle-même (65536 lignes)

Sub CountDateFromTo()
Dim DateFrom As Date
Dim DateTo As Date
Dim Tableau As Variant
Dim DateInclusiveCount As Long, i As Long

With Sheets("Sheet1")
DateFrom = .Range("B1")
DateTo = .Range("B2")
End With

Tableau = Sheets("Sheet2").Range("A1:A50000") 'à adapter

For i = 1 To UBound(Tableau)
If Tableau(i, 1) >= DateFrom And Tableau(i, 1) <= DateTo Then
DateInclusiveCount = DateInclusiveCount + 1
End If
Next i

With Sheets("Sheet1")
.Range("B3") = DateInclusiveCount
.Range("C3") = "Nombre d'entrées inclusives"
End With
End Sub


Ici je retourne le nombre trouvé en "Sheet1" "B3" à toi d'adapter....

Bon Aprèm
@+Thierry
 
T

tracor

Guest
re re thierry

super
et maintenant si je veux ajouter des conditions comme des filtres automatiques
sur différents critères
par exemple
j'ai le total de mon interval
je souhaite y soustraire
les cas de dossier cloturé (colonne b)
les cas de dossier "client absent) colonne c
les cas de dossier procédure colonne c également

tracor
 
@

@+Thierry

Guest
Re Tracor

Et bien qu'à celà ne tienne .... !!! (Bis Répetita !)

Option Explicit
Option Compare Text 'Attention pour les MAJ / MIN

Sub CountDateFromTo()
Dim DateFrom As Date
Dim DateTo As Date
Dim Tableau As Variant
Dim DateInclusiveCount As Long, i As Long

With Sheets("Sheet1")
DateFrom = .Range("B1")
DateTo = .Range("B2")
End With

Tableau = Sheets("Sheet2").Range("A1:C50000") 'Attention dimensionnement sur plage "A" à "C"

For i = 1 To UBound(Tableau)

If Tableau(i, 1) >= DateFrom And Tableau(i, 1) <= DateTo Then
If Not Tableau(i, 2) = "Cloturé" And Not Tableau(i, 3) = "client absent" And Not Tableau(i, 3) = "Procédure" Then
DateInclusiveCount = DateInclusiveCount + 1
End If
End If
Next i

With Sheets("Sheet1")
.Range("B3") = DateInclusiveCount
.Range("C3") = "Nombre d'entrées inclusives"
End With
End Sub


NB attention respecter Colonne B = Tableau(i, 2) et Colonne C = Tableau (i, 3)

Bon Aprèm
@+Thierry
 
T

tracor

Guest
une petite dernière pour la route

lorsque je fais plusieurs conditons sur la même colonne
il ne m'additionne pas le résultat il me met la valeur 0

If Tableau(i, 31) = "Adresse erronée" And Tableau(i, 31) = "Procédure livraison" Then

y a t il une instruction manquante dans l'instruction

merci

tracor
 
@

@+Thierry

Guest
Re Tracor, le Forum

Quand tu écris ceci :
If Tableau(i, 31) = "Adresse erronée" And Tableau(i, 31) = "Procédure livraison" Then

C'est très différent de ceci :
If Not Tableau(i, 2) = "Cloturé" And Not Tableau(i, 3) = "client absent" And Not Tableau(i, 3) = "Procédure" Then

Dans le second cas je suis en négation
SI l'item N'EGALE PAS "Cloturé"
ET si l'item N'EGALE PAS "client absent"
ET si l'item N'EGALE PAS "Procédure"
ALORS.... J'additionne les Items...

Dans le premier cas tu écris ceci :
SI l'item EGALE "Adresse erronée"
ET si l'item EGALE "Procédure livraison"
ALORS...

Je doute fort que le même item puisse avoir les DEUX valeurs...

Tu devrais essayer :
If Tableau(i, 31) = "Adresse erronée" Or Tableau(i, 31) = "Procédure livraison" Then
Et je pense que celà devrait rentrer dans l'ordre...

A Noter que si tu as beaucoup de Tests à comptabiliser on peut passer par un Select Case à l'intérieur de la Boucle :
For i = 1 To UBound(Tableau)
Select Case Tableau(i, 31)
Case "Adresse erronée"
Bad = Bad + 1
BadAddress = BadAdress + 1
Case "Procédure livraison"
Bad = Bad + 1
ProcLiv = ProcLiv + 1
Case "Client Absent"
Bad = Bad + 1
ClientAbsent = ClientAbsent + 1
Case "Mauvais Client"
Bad = Bad + 1
MauvaisClient = MauvaisClient + 1
Case Else
Good = Good + 1
End Select

With Sheets("Sheet1")
.Range("A1") = "Nombre Dossier Bloqués :"
.Range("B1") = Bad
.Range("A2") = "Nombre Adresse erronée :"
.Range("B2") = BadAddress
.Range("A3") = "Procédure livraison :"
.Range("B3") = ProcLiv
.Range("A4") = "Client Absent :"
.Range("B4") = ClientAbsent
.Range("A5") = "Mauvais Client :"
.Range("B5") = MauvaisClient
.Range("A6") = "Autres Cas les Bons !":"
.Range("B6") = Good
End With

On n'oublieara pas de déclarer les Variables Bad As Integer (Jusqu'à 32,767), et aussi BadAddress, ProcLiv, etc...

Bonne Fin de Journée
@+Thierry
 
T

tracor

Guest
slt le phorum

comment puis d'après les instructions énnoncées dans ce fil pour la macro
comptabiliser un nombre de jour ouvré entre 2 dates pour ensuite calculer un taux de livraison qui ne doit pas dépasser 2 jours ouvrés

merci d'avance
 

Discussions similaires

Statistiques des forums

Discussions
312 294
Messages
2 086 902
Membres
103 404
dernier inscrit
sultan87