Gestion du format de la date pour le filtre d'un tableau

Le 17/08/2020 à 12:08

Hello l'equipe,

L'objectif de la macro est de récupérer une valeur dans un tableau par un filtre de date ( en anglais) et d'un autre critère pour les lignes et un filtrage de colonne unpeu bidoullé.

En principe, la macro doit fonctionner mais je rencontre un problème au niveau de la gestion du format de la date.

La date qui me permet de filtrer le tableau ne match pas niveau format donc je me retrouve avec un tableau vide.

Auriez vous une gestion des dates assez rigoureuse a me conseiller afin d'éviter de genre d'erreur ?

Je précise aussi que dans l'idéal l'ensemble des dates soit en anglais et que le traitement par vba le garde.

Car lors de l'exécution de la macro, le format des dates switch de français à anglais ( vu des Variables locales ). Voici le ci joint le code et un fichier test

Public Function NumCol2Lettre(ByVal NumCol As Long) As String
Dim i As Long, x As Long, s As String
For i = 6 To 0 Step -1
x = (26 ^ (i + 1) - 1) / 25 - 1
If NumCol > x Then
s = s & Chr(((NumCol - x - 1) \ 26 ^ i) Mod 26 + 65)
End If
Next i
NumCol2Lettre = s
End Function
20filtretest.xlsm (22.00 Ko)
Sub volNumberP()

Dim wsVol As Worksheet

Dim weightsStrike As Double, volColumns As String

Dim plageStrike As Range, Rng As Range

Dim dateCalculation As Date

Dim maturite As Date

Dim volperiod As String

Dim nbJourDiff As Integer

maturite = Workbooks("filtreTest.xlsm").Sheets("Feuil2").Range("B2").Value

dateCalculation = Workbooks("filtreTest.xlsm").Sheets("Feuil2").Range("B3").Value

weightStrike = Workbooks("filtreTest.xlsm").Sheets("Feuil2").Range("B1").Value

maturite = Format(CDate(maturite), "mm/dd/yy")

dateCalculation = Format(CDate(dateCalculation), "mm/dd/yy")

nbJourDiff = DateDiff("d", dateCalculation, maturite)

Set wsVol = Sheets("Feuil1")

Select Case nbJourDiff

         Case 0 To 1

            MsgBox ("Petit souci avec la vol")

        Case 1 To 7

            volperiod = "1W"

        Case 7 To 14

            volperiod = "2W"

        Case 14 To 21

            volperiod = "3W"

        Case 22 To 30

            volperiod = "1M"

        Case 31 To 60

            volperiod = "2M"

        Case 61 To 90

            volperiod = "6M"

        Case 91 To 180

            volperiod = "9M"

        Case 181 To 270

            volperiod = "12M"

        Case 271 To 450

            volperiod = "18M"

        Case 451 To 720

            volperiod = "2Y"

        Case Is > 721

End Select

Set plageStrike = wsVol.Range("C1:D1")

Set vol = plageStrike.Find("Strike_" & weightStrike, Range("C1"), SearchOrder:=xlByColumns)

volColumns = NumCol2Lettre(vol.Column)

    With wsVol

        .AutoFilterMode = False

        .Range("A2").AutoFilter field:=1, Criteria1:=Array(2, dateCalculation), Operator:=xlFilterValues

        .Range("A2").AutoFilter field:=2, Criteria1:=volperiod

        Set Rng = .AutoFilter.Range

        MsgBox .Range(volColumns & "2:" & volColumns & .Cells(Rows.Count, volColumns).End(xlUp).Row).SpecialCells(xlCellTypeVisible)

    End With

End Sub

Mercii et bonne journée

Lucy

Le 17/08/2020 à 17:47

bonjour,

C'est pas possible des classeurs comme ça : Il faut commencer par passer 10 minutes à supprimer les lignes qui ne servent à rien : Tu n'encourages pas beaucoup les bonnes volontés !

Ta date en format personnalisé Feuil2 en B2 ne me dit rien qui vaille. Mets doit en format Date courte ça ira très bien. Ainsi que B3

Une vraie date (en l'absence de manipulation hasardeuse doit s'aligner à droite dans ta cellule) comme tu as aligné ça à gauche en B2 ça ne veut plus dire grand chose, mais si tu prends n'importe quelle cellule non formatée G2 par exemple et si tu écris =B2 le résultat s'écrit aligné à gauche preuve que cette date n'en est pas une.

Comme je ne sais pas comment utiliser la macro je ne peux pas te dire grand chose... Mébon tu peux peut-être essayer de

Dim maturite As Long
Dim dateCalculation As Long

ensuite supprime

'maturite = Format(CDate(maturite), "mm/dd/yy")
'dateCalculation = Format(CDate(dateCalculation), "mm/dd/yy")

Le reste sans changement et ça devrait passer ...si le reste de ton code est pas trop pourri.

A+

Le 17/08/2020 à 18:20

Hello galopin

Merci de ton retour et pour les indications , je vais creuser la question!

Par contre, tu n'encourages pas vraiment les débutants en les méprisants ;)

Excellente fin de journée

Lucy

Le 17/08/2020 à 18:24
Lucy a écrit :

La date qui me permet de filtrer le tableau ne match pas niveau format donc je me retrouve avec un tableau vide.

Auriez vous une gestion des dates assez rigoureuse a me conseiller afin d'éviter de genre d'erreur ?

Lucy

Bonjour Lucy,

je n'ai pas (encore) regardé en détail ton fichier, mais pour un filtre avancé par exemple, il faut mettre la date en format standard !! c'est à dire une valeur numérique (44060 pour aujourd'hui)

Le 17/08/2020 à 18:30

Feuil2 en B2 ta date, c'est du texte et non une date

Le 17/08/2020 à 18:40

autre point que j'ai remarqué

weightStrike = Workbooks("filtreTest.xlsm").Sheets("Feuil2").Range("B1").Value

il faut que cela corresponde au titre ... qui a une décimale

je pense qu'il faudrait mettre

weightStrike = format(Workbooks("filtreTest.xlsm").Sheets("Feuil2").Range("B1").Value,"00,0")
Le 17/08/2020 à 20:48
Steelson a écrit :

Feuil2 en B2 ta date, c'est du texte et non une date

je comprends mieux ... quelqu'un a voulu introduire directement e format mm/jj/aa, du coup la première date c'est du texte et la seconde est à l'envers probablement !

un conseil ou deux pour les dates

  1. évite de les centrer et élargis un peu la colonne : on voit de suite ce qui est en texte ou en date
  2. si tu es française et que les dates sont anglais, essaie de mettre le mois en lettre ... là cela risque de ne pas fonctionner
Le 17/08/2020 à 20:49

une proposition

Sub filtrer()
    Range("A5").CurrentRegion.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
        Range("A1:B2"), Unique:=False
    ActiveWindow.SmallScroll Down:=-24
End Sub
Sub raz()
    On Error Resume Next
    ActiveSheet.ShowAllData
End Sub
7filtretest.xlsm (19.46 Ko)
Le 18/08/2020 à 10:55

Helloo Steelson,

Merci d'avoir pris le temps pour les explications et les conseils je les ai prise en note

Concernant votre proposition, elle est diaboliquement efficace, je vais essayer de l'adapter afin de pouvoir récupérer une valeur car dans l"idée je souhaite un filtre dans la colonne par le critère weightStrike et récuperer la valeur qui corresponds

Oui je suis française mais je travaille avec des données uniquement en anglais donc je souhaite pouvoir garder les data d'origine

Merci encore, dès que mon adaptation est prête je la ferai suivre

A toute a l'heure

Lucy

Le 18/08/2020 à 13:07
Lucy a écrit :

elle est diaboliquement efficace,

Note que je l'ai juste faite par apprentissage avec le seule changement de mettre currentregion !

J'aime bien

  1. les codes les plus courts possibles
  2. faire les calculs comme les recherchev ici via les feuilles
Le 18/08/2020 à 14:28

Je vais travailler un peu (beaucoup) ce genre de paramètre, j'ai l'impression de faire compliqué pour pas grand chose hihi

J'aspire aussi à pouvoir faire la même chose mais il est que je n'utilise pas beaucoup la recherche V

Pourriez vous jeter une œil à ceci ?ça ne marche pas mais j'ai mise l'idée

Je voudrais sélectionner la valeur qui corresponds au paramètre weightStrike (qui est en colonne ) après le filtre, je n'arrive pas à allier les cellules visibles et l'offset

Sub filtrerValeurPrecise()

Range("A5").CurrentRegion.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
    Range("A1:B2"), Unique:=False
ActiveWindow.SmallScroll Down:=-24

weightStrike = Sheets("Feuil2").Range("B1").Value

Set plageStrike = Sheets("Feuil2").Range("C5:R6")

Set vol = plageStrike.Find("Strike_" & weightStrike, Range("G6"), SearchOrder:=xlByColumns)

volatilite = vol.SpecialCells(xlCellTypeVisible).Offset(1, 0).Value

End Sub

Merci encore Steelson!!!

Le 18/08/2020 à 18:02

Essaie ce test et dis moi ce qui se passe !

Sub test()
    weightStrike = Sheets("Feuil2").Range("B1").Value
    MsgBox weightStrike
    Set plageStrike = Sheets("Feuil2").Range("C5:R6")
    MsgBox plageStrike.Address
    Set vol = plageStrike.Find("Strike_" & weightStrike, Range("G6"), SearchOrder:=xlByColumns)
    MsgBox vol.Address
End Sub
Le 18/08/2020 à 18:22

Une correction ...

Sub raz()
    On Error Resume Next
    ActiveSheet.ShowAllData
End Sub

Sub filtrerValeurPrecise()
    raz
    nb = Range("A5").CurrentRegion.Rows.Count
    Range("A5").CurrentRegion.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("A1:B2"), Unique:=False
    weightStrike = Sheets("Feuil2").Range("B1").Value
    Set plageStrike = Sheets("Feuil1").Range("A5:D5")
    Set vol = plageStrike.Find("Strike_" & Format(weightStrike, "#0.0"), SearchOrder:=xlByColumns)
    MsgBox "Strike_" & Format(weightStrike, "#0.0") & " trouvé en " & vol.Address
    volatilite = vol.Resize(nb, 1).Offset(1).SpecialCells(xlCellTypeVisible).Value
    MsgBox volatilite
End Sub
  • je commence par tout afficher
  • je calcule le nombre de lignes, nb, qui sera utilisée plus tard
  • attention au format de weightStrike sinon il ne trouve rien
    7filtretest.xlsm (20.84 Ko)
Le 19/08/2020 à 12:30

Re steelson,

J'ai testé et adapté ton code il marche super bien !!! Mercii :)

J'ai essayé de l'adapter à un autre de tableau mais qui nécessite seulement un critère, j'ai fais une tentative avec le filtre automatique mais ça n'a pas fonctionné

Aurais tu une idée ? car il me semble avoir bien adapté le code ( si tu as d'autres remarques je suis preneuse!! )

Sub filtrerValeurRate()

    raz

    Set wsParametres = Sheets("Parametres")
    Set wsRate = Sheets("Rate")

    With wsRate
        nb = .Range("A1").CurrentRegion.Rows.Count
        '.Range("A2").AutoFilter Field:=1, Criteria1:=wsParametres.Range("A2"), Operator:=xlFilterValues
        .Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=wsParametres.Range("A1:A2"), Unique:=False
    End With

    periodRate = wsParametres.Range("H2").Value
    refRate = wsParametres.Range("G2").Value

    Set plageRate = wsRate.Range("E1:R1")
    Set Rated = plageRate.Find(refRate & periodRate, SearchOrder:=xlByColumns)

    finalRate = Rated.Resize(nb, 1).Offset(1).SpecialCells(xlCellTypeVisible).Value

    MsgBox finalRate
End Sub
2filtretestr.xlsm (26.95 Ko)

Merci et bonne journée

Le 19/08/2020 à 12:55

Voici une correction

Sub filtrerValeurRate()

    Set wsParametres = Sheets("Parametres")
    Set wsRate = Sheets("Rate")

    With wsRate
        On Error Resume Next
            .ShowAllData
        On Error GoTo 0
        nb = .Range("A1").CurrentRegion.Rows.Count
        .Range("A4").CurrentRegion.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=.Range("A1:A2"), Unique:=False
    End With

    periodRate = wsParametres.Range("H2").Value
    refRate = wsParametres.Range("G2").Value

    Set plageRate = wsRate.Range("B4:M4")
    Set Rated = plageRate.Find(refRate & periodRate, SearchOrder:=xlByColumns)

    finalRate = Rated.Resize(nb, 1).Offset(1).SpecialCells(xlCellTypeVisible).Value

    MsgBox finalRate

End Sub

les critères doivent être sur la même page et les en-têtes rigoureusement les mêmes

6filtretestr.xlsm (18.04 Ko)
Le 19/08/2020 à 12:58

Il y a aussi des façons plus simples de trouver la réponse avec ou sans VBA !

7filtretestr.xlsx (11.08 Ko)
Le 19/08/2020 à 16:03

C'est noté merci !! ça marche nickel du coup, il manque plus que je transforme tout ça en fonction et ça sera bon :)

Tu m'as découvrir ça, j'ai commencé plutôt à me familiariser avec vba plutôt qu'utiliser excel ( pas un choix si judicieux !), je vais creuser cette histoire

Enfaite, j'ai préféré faire du vba car cette macro va être incorporé dans une autre, je trouvais ça plus "simple" que de commencer à jouer avec les deux

En tous cas merci d'avoir pris le temps, j'ai beaucoup apprise avec vous!!!

Lucy

Rechercher des sujets similaires à "gestion format date filtre tableau"