TODAY en VBA inclus dans un COUNTIF

Le 23/10/2018 à 09:56

Bonjour à tous,

Je me heurte à un petit soucis de MACRO, j'aimerai faire un simple CountIfs en prenant dans un premier temps une données simple et dans un second temps une période. C'est cette période que je n'arrive pas à faire... Je souhaiterai donc savoir combien de fois une valeur est apparu dans les 3 derniers mois.

En formule ca donne : =NB.SI.ENS('OI General'!AH:AH;'RFW''MISP'!A2;'OI General'!O:O;CONCATENER(">";AUJOURDHUI()-365))

et en VBA j'ai essayé ceci:

TTM.Range("L"&i).Value = WorksheetFunction.Countifs(OIGeneral.Range("AH4:AH" & Derligne2), TTM.Range("A"&i), OIGeneral.Range(O4:O"&Derligne2),"">""&"=TODAY()"-91)

C'est donc cette partie qui doit être mauvaise..

"">""&"=TODAY()"-91

Pourriez-vous m'aider svp

Merci d'avance,

FloBru

Le 23/10/2018 à 10:06

Salut FloBru,

Possibilité d'avoir ton fichier ?

Tu a oublié un guillemet dans ton code ci-dessous :

TTM.Range("A"&i), OIGeneral.Range(O4:O"&Derligne2),"">""&"=TODAY()"-91)

Remplace par :

TTM.Range("A"&i), OIGeneral.Range("O4:O" & Derligne2),"">""&"=TODAY()"-91)
Le 23/10/2018 à 10:12

Salut Juice,

Malheureusement, c'est une base avec des données condidentielles et ca serait un peu long de la refaire avec des données fictives pour ce dev...

Merci pour la guillemet oubliée Malheureusement, ca ne fonctionne toujours pas..

Le 23/10/2018 à 10:24

Bonjour,

Si je puis me permettre :

CountIfs ou CountIf ?

TODAY est une fonction Excel, non utilisable en VBA par la méthode WorksheetFunction.

Et si le calcul vise un délai en mois, 91 sont des jours...

Cordialement.

Le 23/10/2018 à 10:29

Bonjour MFerrand,

En effet j'utilise CountIfs car j'ai plusieurs conditions.

Y'a t-il un moyen d'utiliser une valeur du type TODAY() en VBA ou autre moyen renvoyant la date du jour ou on fait tourner la MACRO?

En effet 91 represente des jours car cela represente environ 3 mois... cela est peut-etre une erreur mais je me suis basé sur la facon de travailler en formules

Merci

Le 23/10/2018 à 10:33

@FloBru

Malheureusement, c'est une base avec des données condidentielles et ca serait un peu long de la refaire avec des données fictives pour ce dev...

Même en sélectionnant les colonnes que tu ne souhaite pas que nous voyons et en cliquant sur effacer le contenu sa n'irai pas vite :0 ?

@MFerrand

TODAY est une fonction Excel, non utilisable en VBA par la méthode WorksheetFunction.

C'est DATE qui remplace TODAY en VBA non ?

capture
Le 23/10/2018 à 10:37

En effet 91 represente des jours car cela represente environ 3 mois

Pour les mois tu peut utiliser MONTH :

capture
Le 23/10/2018 à 10:40

Oui Juice, c'est Date...

FloBru:

En effet 91 represente des jours car cela represente environ 3 mois... cela est peut-etre une erreur mais je me suis basé sur la facon de travailler en formules

J'aurais fait la même remarque s'agissant de formules !

Le 23/10/2018 à 10:53

C'est vrai qu'en mois ca peut-être mieux

Malheureusement même en utilisant DATE

C'est DATE qui remplace TODAY

ca me renvois la valeur sans filtre sur la date..
Le 23/10/2018 à 11:02

ca me renvois la valeur sans filtre sur la date..

Malheureusement sans le fichier pour tester ton code, je peux pas aller plus loin pour t'aider que sa :/

A moins que tu nous dise à quoi font références ces deux Objets :

OIGeneral.Range

et

TTM.Range

Que je puisse les reproduire sur un Excel de mon côté

Le 23/10/2018 à 13:55

A moins que tu nous dise à quoi font références ces deux Objets

Bien évidement, TTM représente la base dans laquelle les données sont rentrées et OIGeneral est la base de données sources pour le countifs.

Merci

Le 23/10/2018 à 14:06

A moins que tu nous dise à quoi font références ces deux Objets

Bien évidement, TTM représente la base dans laquelle les données sont rentrées et OIGeneral est la base de données sources pour le countifs.

Merci

Le 23/10/2018 à 15:50

Bon, plutôt que d'essayé de corriger ta macro sans le fichier, je te propose de la reprendre du début !

Voici donc ci-dessous un code pour compter le nombre de fois où apparaît une date comprise entre la date du jour et la date du jour moins trois mois :

Sub CountIF()
'Pour ta boucle :
Dim x As Long, y As Long
'Pour tes dates à analyser :
Dim Ye As Long, Mo As Long
'Pour ton compteur :
Dim Compteur As Long
'Cpt nbr ligne en colonne 2 feuille 1 :
x = Sheets(1).Range("B" & Rows.Count).End(xlUp).Row
'On remet ton compteur à zéro :
Compteur = 0
'On boucle :
For y = 2 To x
Cells(y, 2).Select
'On décomponse la date que tu a inscrit
Ye = Year(Cells(y, 2))
Mo = Month(Cells(y, 2))
'Les conditions (propre à ton CountIf) :
'Condition 1 : Si l'année de ma cellule est égal à l'année en-cours
'Condition 2 : Si le mois de ma cellule est égal ou supérieur au mois en-cours - 3
    If Ye = Year(Date) And Mo >= Month(Date) - 3 Then
'Si conditions remplies alors on rajoute +1 au compteur :
        Compteur = Compteur + 1
    End If
Next
'On affiche le résultat du compteur
MsgBox "Il y a " & Compteur & " valeurs (sur " & x & ") apparues dans les trois dernier mois."
'Ou on le rentre dans une cellule
Cells(1, 1) = Compteur
End Sub

Restant à ta dispo si besoin

Le 24/10/2018 à 09:16

Bonjour,

Merci ennormement pour vos réponses!!!!

Je pense que je suis vraiment mauvais car je n'arrive pas à l'adapter sur ma MACRO...

Voici mon code complet:

'Fonction vérification ouverture fichier
Private Function EstOuvert(Coln As Object, Item As String) As Boolean
    Dim obj As Object
    On Error Resume Next
    Set obj = Coln(Item)
    EstOuvert = Not obj Is Nothing
End Function

Sub F_FWR()

Application.Calculation = xlCalculationManual 'Accélération Macro

''''''''''''''''''''''''''''''''Recuperation of Ref in OI General tab''''''''''''''''''''''''''''''''

'Définition des variables de travail
Dim N As Long
Dim rng As Range
Dim t As Single
    t = Timer
    N = Worksheets("OI General").Cells(Rows.Count, 34).End(xlUp).Row
    On Error Resume Next
    Set rng = Worksheets("OI General").Cells(34).Resize(N).SpecialCells(xlCellTypeConstants)
    On Error GoTo 0
    If Not rng Is Nothing Then
        rng.Copy Destination:=Worksheets("RFW'MISP").Cells(1)
        Worksheets("RFW'MISP").Cells(1).CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlYes
    End If
    'MsgBox Format(Timer - t, "0.00") & " seconde(s)", vbInformation, "Durée" 'To inform about process duration

''''''''''''''''''''''''''''''''Recuperation of all data from other files''''''''''''''''''''''''''''''''

'Définition des onglets de travail
Dim OIGeneral As Variant
Dim TTM As Variant
Dim ELIPS320 As Variant
Dim ELIPS330 As Variant
Dim ELIPS350 As Variant

'Vérification des fichiers déjà ouverts et ouverture des fichiers fermés
If EstOuvert(Workbooks, "SA Extract.xlsx") = False Then
    Workbooks.Open Filename:=XX
End If
If EstOuvert(Workbooks, "LR Extract.xlsx") = False Then
    Workbooks.Open Filename:=XX
End If
If EstOuvert(Workbooks, "XW Extract.xlsx") = False Then
    Workbooks.Open Filename:=XX
End If

'Assignation des onglets de travail
Set OIGeneral = Workbooks("XXX General - KPI.xlsm").Worksheets("OI General")
Set TTM = Workbooks("XXX General - KPI.xlsm").Worksheets("FWR")
Set ELIPS320 = Workbooks("SA Extract.xlsx").Worksheets("MISSdb_extract")
Set ELIPS330 = Workbooks("LR Extract.xlsx").Worksheets("MISSdb_extract")
Set ELIPS350 = Workbooks("XW Extract.xlsx").Worksheets("MISSdb_extract")

TTM.Activate 'Activation par défaut de l'onglet RFW'MISP & TTM

Derligne = TTM.Range("A" & Rows.Count).End(xlUp).Row 'Définition de la dernière ligne TTM de la colonne A
Derligne2 = OIGeneral.Range("A" & Rows.Count).End(xlUp).Row 'Définition de la dernière ligne OI General de la colonne A

For i = 2 To Derligne
    'Ref.
    If IsError(Application.VLookup(TTM.Range("A" & i).Value, ELIPS320.Range("A:Z"), 25, False)) Then 'ELIPS A320
        If IsError(Application.VLookup(TTM.Range("A" & i).Value, ELIPS330.Range("A:Z"), 25, False)) Then 'ELIPS A330
            If IsError(Application.VLookup(TTM.Range("A" & i).Value, ELIPS350.Range("A:Z"), 25, False)) Then 'ELIPS A350
                'MsgBox "The MISP/RFW " & TTM.Range("A" & i).Value & " is not in ELIPS extracts."
            Else
                TTM.Range("B" & i).Value = WorksheetFunction.VLookup(TTM.Range("A" & i).Value, ELIPS350.Range("A:Z"), 25, False)
            End If
        Else
            TTM.Range("B" & i).Value = WorksheetFunction.VLookup(TTM.Range("A" & i).Value, ELIPS330.Range("A:Z"), 25, False)
        End If
    Else
        TTM.Range("B" & i).Value = WorksheetFunction.VLookup(TTM.Range("A" & i).Value, ELIPS320.Range("A:Z"), 25, False)
    End If

    'Title
    If IsError(Application.VLookup(TTM.Range("A" & i).Value, ELIPS320.Range("A:B"), 2, False)) Then 'ELIPS 320777
        If IsError(Application.VLookup(TTM.Range("A" & i).Value, ELIPS330.Range("A:B"), 2, False)) Then 'ELIPS 330138
            If IsError(Application.VLookup(TTM.Range("A" & i).Value, ELIPS350.Range("A:B"), 2, False)) Then 'ELIPS 350152

            Else
                TTM.Range("C" & i).Value = WorksheetFunction.VLookup(TTM.Range("A" & i).Value, ELIPS350.Range("A:B"), 2, False)
            End If
        Else
            TTM.Range("C" & i).Value = WorksheetFunction.VLookup(TTM.Range("A" & i).Value, ELIPS330.Range("A:B"), 2, False)
        End If
    Else
        TTM.Range("C" & i).Value = WorksheetFunction.VLookup(TTM.Range("A" & i).Value, ELIPS320.Range("A:B"), 2, False)
    End If

    'Status
    If IsError(Application.VLookup(TTM.Range("A" & i).Value, ELIPS320.Range("A:K"), 11, False)) Then 'ELIPS A320
        If IsError(Application.VLookup(TTM.Range("A" & i).Value, ELIPS330.Range("A:K"), 11, False)) Then 'ELIPS A330
            If IsError(Application.VLookup(TTM.Range("A" & i).Value, ELIPS350.Range("A:K"), 11, False)) Then 'ELIPS A350

            Else
                TTM.Range("F" & i).Value = WorksheetFunction.VLookup(TTM.Range("A" & i).Value, ELIPS350.Range("A:K"), 11, False)
            End If
        Else
            TTM.Range("F" & i).Value = WorksheetFunction.VLookup(TTM.Range("A" & i).Value, ELIPS330.Range("A:K"), 11, False)
        End If
    Else
        TTM.Range("F" & i).Value = WorksheetFunction.VLookup(TTM.Range("A" & i).Value, ELIPS320.Range("A:K"), 11, False)
    End If

    'OR3M event
    TTM.Range("J" & i).Value = WorksheetFunction.CountIf(OIGeneral.Range("AH4:AH" & Derligne2), TTM.Range("A" & i))

'Rolling 3 months
    TTM.Range("K" & i).Value = WorksheetFunction.CountIfs(OIGeneral.Range("AH4:AH" & Derligne2), TTM.Range("A" & i), OIGeneral.Range("O4:O" & Derligne2), ">" & Date)

    'Rolling 12 months
    'TTM.Range("L" & i).Value = WorksheetFunction.CountIfs(OIGeneral.Range("AH4:AH" & Derligne2), TTM.Range("A" & i), OIGeneral.Range("O4:O" & Derligne2), "" > "" & "=TODAY()" - 365)

Next

End Sub

Mon problème porte toujours sur ces 2 lignes:

'Rolling 3 months
    TTM.Range("K" & i).Value = WorksheetFunction.CountIfs(OIGeneral.Range("AH4:AH" & Derligne2), TTM.Range("A" & i), OIGeneral.Range("O4:O" & Derligne2), ">" & Date)

    'Rolling 12 months
    'TTM.Range("L" & i).Value = WorksheetFunction.CountIfs(OIGeneral.Range("AH4:AH" & Derligne2), TTM.Range("A" & i), OIGeneral.Range("O4:O" & Derligne2), "" > "" & "=TODAY()" - 365)

Comment puis-je donc adapter ta solution à mon code?

Merci d'avance et désolé pour la perte de temps due à mon incompréhension..

FloBru

Rechercher des sujets similaires à "today vba inclus countif"