Fonction qui récupère des données filtrés et sort un tableau comme résultat

Le 31/08/2020 à 16:27

hello la team,

J'aurais besoin de vos lumières!

J'essaye de faire une fonction qui permet de récupérer des données filtrées avec une date de début et une date de fin sur un autre fichier (fichier source ici ticker1 ). Le résultat devrait sortir sous forme de tableau mais je n'obtiens que la value de la première cellule

Public Function dataHisto(ticker As String, Datedebut As String, Datefin As String) As Variant

Dim FilePath As String
Dim wbTicker As Workbook
Dim wsTicker As Worksheet
Dim Rng As Range

FilePath = "C:" & ticker & ".xlsx"

Set wbTicker = Workbooks.Open(FilePath)
Set wsTicker = wbTicker.Sheets("Feuil1")

    With wsTicker
        .AutoFilterMode = False
        .Range("A2").AutoFilter Field:=1, Criteria1:=">=" & Format(Datedebut, "mm/dd/yyyy"), _
        Operator:=xlAnd, Criteria2:="<=" & Format(Datefin, "mm/dd/yyyy"), VisibleDropDown:=False

        Set Rng = .AutoFilter.Range
        dataHisto = Rng.Value
    End With

wbTicker.Close SaveChanges:=False

End Function

Merci à vous !!

Lucy

Le 31/08/2020 à 16:28
60ticker1.xlsx (9.07 Ko)
58macro.xlsm (12.68 Ko)

Voici les fichiers !

Lucy

Le 31/08/2020 à 17:12

Bonjour,

Il n'est pas possible de, directement, transférer des données d'une plage discontinue (ce que créé le filtre) vers une variable tableau.

Tu dois donc boucler sur toutes tes lignes...

Le 31/08/2020 à 18:21

hello Franck,

Merci je comprends mieux mais quel dommage...

Je vais essayer ça mais j'avais pensé à copier la range visible provoqué par le filtre ( j'ai pas encore essayé )

Je vais faire les deux et les faire suivre, merci d'avoir pris le time Franck!!

Lucy

Le 01/09/2020 à 09:12

Salut,

Je te mets +1 pour l'idée.

Cela faisait un moment que je cherchais à créer une fonction qui créé une variable tableau à partir d'un range discontinu.

C'était tout bête... La Méthode Copy ne copiant que les cellules visibles...

Donc, voici le code de la fonction (As Variant pour ne pas se préoccuper des différents types de données de la feuille initiale) :

Function LoadFilteredDatas(Target As Range) As Variant
'     Target = Range filtré
    With ThisWorkbook.Worksheets.Add
        Target.Copy .Range("A1")
        LoadFilteredDatas = .Range("A1").CurrentRegion.Value '  CurrentRegion peut être adapté
        Application.DisplayAlerts = False
        .Delete
        Application.DisplayAlerts = True
    End With
End Function

Fonction que l'on peut appeler comme ceci (ne pas tenir compte des ActiveSheet, c'est un exemple...) :

Sub TestLoadFilteredDatas()
Dim Datas, Rng As Range
    ActiveSheet.ListObjects("Tableau1").Range.AutoFilter Field:=7, Criteria1:="Machin"
    'ATTENTION ICI, BUG POSSIBLE SI AUCUNE LIGNE MASQUEE
    Set Rng = ActiveSheet.AutoFilter.Range.Cells.SpecialCells(xlCellTypeVisible)
    Datas = LoadFilteredDatas(Rng)
    Debug.Print UBound(Datas, 1), UBound(Datas, 2), Datas(2, 3)
End Sub
Le 01/09/2020 à 13:53

hello Franck,

Merci bien pour les indications, je vais appliquer ta proposition et je ferais suivre

si tu as d'autres remarques je suis preneuse :)

Lucy

Le 01/09/2020 à 14:28
Lucy a écrit :

si tu as d'autres remarques je suis preneuse :)

Salut Lucy,

Une autre remarque serait de faire l'inverse, à savoir transférer une variable tableau vers une plage discontinue.

Supposons.

Tu fais un filtre sur ta feuille, transfère le résultat de ton filtre dans une variable tableau, modifie certaines données dans ta variable tableau.

Comment transfère tu les données dans ta feuille?

Avec une boucle. Tu n'as pas d'autre choix...

Je vais y réfléchir et j'ai déjà ma petite idée...

Le 02/09/2020 à 10:52

Hello Franck,

A vrai dire je suis encore entrain d'essayer ton code ^^', je tente de fusionner ta fonction avec la mienne mais j'ai du mal à sortir un résultat correcte

Je n'ai pas bien compris l'utilisation, pourrais tu m'éclairer ?

.ListObjects("Tableau1")
Debug.Print UBound(Datas, 1), UBound(Datas, 2), Datas(2, 3)

Voici ma proposition, aurait tu un avis dessus ?

Public Function dataHisto(ticker As String, Datedebut As String, Datefin As String) As Variant

Dim FilePath As String
Dim wbTicker As Workbook
Dim wsTicker As Worksheet
Dim Rng As Range

FilePath = "C:" & ticker & ".xlsx"

Set wbTicker = Workbooks.Open(FilePath)
Set wsTicker = wbTicker.Sheets("Feuil1")

    With wsTicker
        .AutoFilterMode = False
        .Range("A2").AutoFilter Field:=1, Criteria1:=">=" & Format(Datedebut, "mm/dd/yyyy"), _
        Operator:=xlAnd, Criteria2:="<=" & Format(Datefin, "mm/dd/yyyy"), VisibleDropDown:=False
        Set Rng = .AutoFilter.Range.Cells.SpecialCells(xlCellTypeVisible)

    End With

    With wbTicker.Worksheets.Add

        Rng.Copy .Range("A1")
        LoadFiltereDatas = .Range("A1").CurrentRegion.Value
        Application.DisplayAlerts = False
        .Delete
        Application.DisplayAlerts = True

    End With

dataHisto = LoadFiltereDatas
wbTicker.Close SaveChanges:=False

End Function
Sub testfunction()

ActiveSheet.Range("J9").Value = dataHisto("ticker1", "06/22/20", "07/07/20")

End Sub

Enfaîte, l'idée reste toujours de sortir un tableau à partir d'une fonction excel mais dans mon cas cela me sort uniquement une seule valeur

Quelques choses comme ceci

capture

Dès que j'ai fini ceci, je serais ravie de réfléchir à l'inverse :)

Merci encore et bonne journée

Le 02/09/2020 à 14:00

Bonjour,

aurait tu un avis dessus ?

J'ai toujours un avis sur tout. Par contre, mon avis n'est pas toujours intéressant...

Par avance, désolé de la longueur de ma réponse....

------------------------------------------------------------------------------------------------------------------------------------------------------------

Tu as (presque) tout bon. Ne te manque plus qu'à "agrandir" le Range de "réception" des données, pour qu'il soit de la même taille que ta variable tableau.

Soit : Nombre de lignes = UBound(TaVariableTableau, 1); Nombre de colonnes = UBound(TaVariableTableau, 2)

Pour cela, on utilise la propriété Resize de l'objet Range (cf. https://docs.microsoft.com/fr-fr/office/vba/api/excel.range.resize)

Soit, une modification de ton code d'appel comme ceci :

Sub testfunction()
Dim datas As Variant
    datas = dataHisto("ticker1", "06/22/20", "07/07/20")
    ActiveSheet.Range("J9").Resize(UBound(datas, 1), UBound(datas, 2)).Value = datas
End Sub

------------------------------------------------------------------------------------------------------------------------------------------------------------

Pour aller plus loin...

Une fonction, en VBA, ne devrait avoir qu'un seul objectif, qu'une seule mission, qu'une unique "fonction". Elle retourne ainsi une valeur (ou plusieurs s'il s'agit d'un tableau), et laisse au code appelant la gestion d'éventuelles erreurs.

Par exemple...

Le code que tu nous as donné dans ton dernier message commence comme ceci :

Public Function dataHisto(ticker As String, Datedebut As String, Datefin As String) As Variant

Dim FilePath As String
Dim wbTicker As Workbook
Dim wsTicker As Worksheet
Dim Rng As Range

FilePath = "C:" & ticker & ".xlsx"

Avec le code d'appel que tu nous donnes, c'est plantage, bug assuré! (ben ouais. Dans ta Function, t'as oublié le \ après C:)

Sub testfunction()
  ActiveSheet.Range("J9").Value = dataHisto("ticker1", "06/22/20", "07/07/20")
End Sub

Juste pour cela, on devrait créer une fonction d'ouverture de classeur, fonction qui, si le classeur existe, l'ouvrirait et renverrait l'objet Workbook.

Je te montre?

Sub Test()
Dim wbTicker As Workbook
Dim rep As String, Nom As String, extens As String
    rep = "C:\Users\" & Environ("username") & "\Desktop\" ' "C:\"
    Nom = "ticker1"
    extens = ".xlsx"
    Set wbTicker = OuvreClasseurSiExist(rep, Nom, extens)
    If Not wbTicker Is Nothing Then
        'ICI la suite du code
            'blablabla
        'fin du code, on ferme le classeur :
        wbTicker.Close SaveChanges:=False
        Set wbTicker = Nothing
    Else
        'ICI, le traitement de l'erreur si le classeur n'existe pas
        MsgBox "Le classeur " & Nom & " n'existe pas dans le répertoire : " & rep
    End If
End Sub

Function OuvreClasseurSiExist(FullPath As String, Name As String, Optional Extension As String = ".xlsx") As Workbook
'   Arguments :
'       FullPath As String : Le chemin complet d'accès au répertoire contenant le fichier.
        '       Exemple : C:\Temp\Fichiers Excel
        '           ou  : C:\Temp\Fichiers Excel\
'       Name As String : Le nom du fichier.
        '       Exemple : "ticker1.xlsm"
        '           ou  : "ticker1" (si l'extension du fixhier est .xlsx, celle-ci peut-être omise)
'       Optional Extension As String = ".xlsx" : L'extension du fichier.
        '       Exemple : ".xlsm"
        '           ou  : rien ==> si l'extension du fixhier est .xlsx, celle-ci peut-être omise
    'Teste si le chemin se termine bien par le séparateur \
    If Right$(FullPath, 1) <> Application.PathSeparator Then FullPath = FullPath & Application.PathSeparator
    'Ajoute l'extension le cas échéant
        'exemple d'appel : OuvreClasseurSiExist("C:\Temp\Fichiers Excel", "ticker1", ".xlsm")
    If InStr(Name, ".") = 0 Then Name = Name & Extension
    If Dir(FullPath & Name) <> vbNullString Then
        'ici, on peut ouvrir le classeur, il existe bien
        Set OuvreClasseurSiExist = Workbooks.Open(FullPath & Name)
    Else
        'Sinon, on renvoie Nothing
        Set OuvreClasseurSiExist = Nothing
    End If
End Function

Oui, en effet, beaucoup de blabla pour ouvrir un classeur. Mais bon, sans les commentaires, c'est "buvable" non?

------------------------------------------------------------------------------------------------------------------------------------------------------------

Le code de ta fonction mériterait donc d'être "morcelé" en plusieurs "petites" fonctions qui ne rempliraient ainsi qu'un seul rôle.

Voici, un peu, comment je verrais ce découpage. Précision : ce ne sera certainement pas le "meilleur code", mais il illustre bien la technique que je souhaite décrire ici...

Option Explicit

Sub Code_Principal()
    'affectation des valeurs aux variables (ici, j'ai rendu l'extension obligatoire)
    CodeAppelDesFonctions "C:\", "ticker1", ".xlsx", "Feuil1", "06/22/20", "07/07/20"
End Sub

Private Sub CodeAppelDesFonctions(rep As String, Nom As String, extens As String, NomFeuil As String, Datedebut As String, Datefin As String)
Dim wbTicker As Workbook
Dim wsTicker As Worksheet, WsDest As Worksheet
Dim Rng As Range
Dim datas As Variant
    Set WsDest = ThisWorkbook.Worksheets("Feuil1") 'A ADAPTER LA FEUILLE DE DESTINATION DES DONNEES
    Set wbTicker = getWorkbook(rep, Nom, extens)
    If Not wbTicker Is Nothing Then
        Set wsTicker = getSheetByName(NomFeuil, wbTicker)
        If Not wsTicker Is Nothing Then
            Set Rng = FilterRange(wsTicker, Format(Datedebut, "mm/dd/yyyy"), Format(Datefin, "mm/dd/yyyy"))
            If Not Rng Is Nothing Then
                datas = GetFilteredDatas(wbTicker, Rng)
                'ICI ON PEUT BALANCER SUR LA FEUILLE
                WsDest.Range("J9").Resize(UBound(datas, 1), UBound(datas, 2)).Value = datas
                Set Rng = Nothing
                Erase datas
            Else
                MsgBox "Il est possible que le filtre : entre : " & Datedebut & " et : " & Datefin & ", ne renvoie aucune données"
            End If
        Else
            MsgBox "La feuille " & NomFeuil & " n'existe pas dans le Classeur : " & Nom
        End If
        Set wsTicker = Nothing
        wbTicker.Close SaveChanges:=False
        Set wbTicker = Nothing
    Else
        MsgBox "Le classeur " & Nom & " n'existe pas dans le répertoire : " & rep
    End If
    Set WsDest = Nothing
End Sub

Private Function getWorkbook(FullPath As String, Name As String, Extension As String) As Workbook
    If Right$(FullPath, 1) <> Application.PathSeparator Then FullPath = FullPath & Application.PathSeparator
    If InStr(Name, ".") = 0 Then Name = Name & Extension
    If Dir(FullPath & Name) <> vbNullString Then
        Set getWorkbook = Workbooks.Open(FullPath & Name)
    Else
        Set getWorkbook = Nothing
    End If
End Function
Private Function getSheetByName(Name As String, Optional Wb As Workbook) As Object
'Pierre Fauconnier
'https://www.developpez.net/forums/blogs/27262-pierre-fauconnier/b8231/vba-excel-verifier-quune-feuille-existe-classeur-trouver-feuille-nom-classeur/
Dim sh As Object, Counter As Long
    If Wb Is Nothing Then Set Wb = ActiveWorkbook
    Counter = 1
    Do While Counter <= Wb.Sheets.Count And getSheetByName Is Nothing
        If StrComp(Wb.Sheets(Counter).Name, Name, vbTextCompare) = 0 Then Set getSheetByName = Wb.Sheets(Counter)
        Counter = Counter + 1
    Loop
End Function
Private Function FilterRange(Wsh As Worksheet, Crit1 As String, Crit2 As String) As Range
    With Wsh
        .AutoFilterMode = False
        .Range("A2").AutoFilter Field:=1, Criteria1:=">=" & Crit1, _
        Operator:=xlAnd, Criteria2:="<=" & Crit2, VisibleDropDown:=False
        On Error Resume Next
        Set FilterRange = .AutoFilter.Range.Cells.SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
    End With
End Function
Private Function GetFilteredDatas(Wbk As Workbook, Target As Range) As Variant
    With Wbk.Worksheets.Add
        Target.Copy .Range("A1")
        GetFilteredDatas = .UsedRange.Value 'en remplacement de CurrentRegion...
        Application.DisplayAlerts = False
        .Delete
        Application.DisplayAlerts = True
    End With
End Function

En cas d'erreur, de plantage, de bug, tu devrais être informée des "retouches" éventuelles à effectuer. Du coup, la maintenance de ton code en est simplifiée, même si, à première vue, ce n'est pas le cas.

------------------------------------------------------------------------------------------------------------------------------------------------------------

Dès que j'ai fini ceci, je serais ravie de réfléchir à l'inverse :)

C'est, à mon avis, inutile...

Le cas que j'évoquais peut-être traité très simplement...

Tu fais un filtre sur ta feuille, transfère le résultat de ton filtre dans une variable tableau, modifie certaines données dans ta variable tableau.

Suffit de : Extraire le contenu de la feuille dans une variable tableau, modifier ce qui doit l'être (un simple test If dans la boucle) et rebalancer dans la feuille...

Donc, inutile de s'y atteler...
------------------------------------------------------------------------------------------------------------------------------------------------------------

Ouf... Vindediou, j'ai rarement fait aussi longue réponse!

Merci de m'avoir lu jusqu'ici...

N'hésite pas!

Le 02/09/2020 à 16:46

Helllo Franck,

Merci avant tout d'avoir pris autant le temps :)!!

J'ai toujours un avis sur tout. Par contre, mon avis n'est pas toujours intéressant...

ahah tout est relatif :P

C'est tout le contraire, c'est plutôt moi qui te remercie pour la longueur de ta réponse !!

-----------------------------------------------------------------------------------------------------------------------------------------------------------------------

Tu es un monstre! cela parait logique maintenant que tu le dis et ça marche nickel

Maintenant, l'étape suivante que j'essaye de me passer d'une procédure et donc intégrer la modification de la plage d'arrivée directement dans la fonction

J'ai essayé ceci ( et plein d'autres qui étaient farfelue ahaha) sans grand succès pour l'instant!

Public Function dataHistosV(ticker As String, Datedebut As String, Datefin As String) As Variant

Application.ScreenUpdating = False

Dim FilePath As String
Dim wbTicker As Workbook
Dim wsTicker As Worksheet
Dim Rng As Range

FilePath = "C:\& ticker & ".xlsx"

Set wbTicker = Workbooks.Open(FilePath)
Set wsTicker = wbTicker.Sheets("Feuil1")

    With wsTicker
        .AutoFilterMode = False
        .Range("A2").AutoFilter Field:=1, Criteria1:=">=" & Format(Datedebut, "mm/dd/yyyy"), _
        Operator:=xlAnd, Criteria2:="<=" & Format(Datefin, "mm/dd/yyyy"), VisibleDropDown:=False
        Set Rng = .AutoFilter.Range.Cells.SpecialCells(xlCellTypeVisible)

    End With

    With wbTicker.Worksheets.Add

        Rng.Copy .Range("A1")
        LoadFiltereDatas = .Range("A1").CurrentRegion.Value
        Application.DisplayAlerts = False
        .Delete
        Application.DisplayAlerts = True

    End With

datas = LoadFiltereDatas

dataHistoV = ActiveSheet.ActiveCell.Resize(UBound(datas, 1), UBound(datas, 2)).Value

wbTicker.Close SaveChanges:=False

Application.ScreenUpdating = True

End Function

------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

Donc dans l'idée vaut mieux cumuler plusieurs petites fonctions et les appeler dans une plus grande ? ( je pose la question mais ça doit être ça :))

Etant donné que je débute encore, je n'avais pas la vision de la gestion d'erreur qui suit derrière... mais je vais appliquer ta méthode ( je n'ai eu que le temps de le lire jusqu’à présent)

Oui, en effet, beaucoup de blabla pour ouvrir un classeur. Mais bon, sans les commentaires, c'est "buvable" non?

Si bien expliqué on ne peut que comprendre :P

------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

Public Function dataHisto(ticker As String, Datedebut As String, Datefin As String) As Variant

Dim FilePath As String
Dim wbTicker As Workbook
Dim wsTicker As Worksheet
Dim Rng As Range

FilePath = "C:" & ticker & ".xlsx"

Par rapport à ceci, c'était une erreur de frappe amis merci de l'avoir relevé, c'est le genre d'erreur que je faisais il y a pas si longtemps!

--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

Cela semble si simple qui comme ça mais j'ai tendance à garder cette gymnastique afin de m'améliorer!

--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

J'ai rarement lu une réponse aussi longue mais merci encore d'avoir pris et de prendre le temps !!

Lucy

Le 02/09/2020 à 17:16

En fait, ta "grande fonction" ne devrait pas en être une...

Tu veux une suite d'instruction (code) qui va t'inscrire un résultat dans des cellules.

C'est donc une procédure (Sub) et pas une fonction (function).

Oublie maintenant les ActiveSheet et autre ActiveCell. Ils ne servent que dans de rares cas...

Voici donc ton code modifié :

Public Sub dataHistosV(ticker As String, Datedebut As String, Datefin As String)   'MODIFIE

Application.ScreenUpdating = False

Dim FilePath As String
Dim wbTicker As Workbook
Dim wsTicker As Worksheet
Dim Rng As Range
Dim datas                                                            'MODIFIE

FilePath = "C:\& ticker & ".xlsx"

Set wbTicker = Workbooks.Open(FilePath)
Set wsTicker = wbTicker.Sheets("Feuil1")

    With wsTicker
        .AutoFilterMode = False
        .Range("A2").AutoFilter Field:=1, Criteria1:=">=" & Format(Datedebut, "mm/dd/yyyy"), _
        Operator:=xlAnd, Criteria2:="<=" & Format(Datefin, "mm/dd/yyyy"), VisibleDropDown:=False
        Set Rng = .AutoFilter.Range.Cells.SpecialCells(xlCellTypeVisible)

    End With

    With wbTicker.Worksheets.Add

        Rng.Copy .Range("A1")
        datas = .UsedRange.Value                                     'MODIFIE
        Application.DisplayAlerts = False
        .Delete
        Application.DisplayAlerts = True

    End With

Worsheets("Feuil1").Range("A1").Resize(UBound(datas, 1), UBound(datas, 2)) = datas            'MODIFIE - A ADAPTER : Worsheets("Feuil1").Range("A1")

wbTicker.Close SaveChanges:=False

Application.ScreenUpdating = True

End Sub

En commentaires mes modifications...

La Sub d'appel, maintenant :

Sub testfunction()
  Call dataHisto("ticker1", "06/22/20", "07/07/20")
End Sub

Call est de + en + décrié car il est facultatif.

On aurait tout aussi bien pu écrire :

Sub testfunction()
  dataHisto "ticker1", "06/22/20", "07/07/20"
End Sub

A titre personnel, je l'utilise quasi tout le temps car je le trouve plus parlant, plus évocateur...

On sait, en le voyant en début de ligne, que l'on appelle une Sub...

Le 02/09/2020 à 17:57

Bonjour à toutes et tous,

Attention !

Dans le cas où rng est vide, il y a erreur. Il faut gérer cette éventualité.

Set Rng = .AutoFilter.Range.Cells.SpecialCells(xlCellTypeVisible)

Cdlt.

Le 03/09/2020 à 11:49

Salut Jean-Eric,

Exact. J'y ai songé dans mon long message, mais pas dans mon dernier code...

Remplacer donc :

    With wsTicker
        .AutoFilterMode = False
        .Range("A2").AutoFilter Field:=1, Criteria1:=">=" & Format(Datedebut, "mm/dd/yyyy"), _
        Operator:=xlAnd, Criteria2:="<=" & Format(Datefin, "mm/dd/yyyy"), VisibleDropDown:=False
        Set Rng = .AutoFilter.Range.Cells.SpecialCells(xlCellTypeVisible)

    End With

    With wbTicker.Worksheets.Add

        Rng.Copy .Range("A1")
        datas = .UsedRange.Value                                     'MODIFIE
        Application.DisplayAlerts = False
        .Delete
        Application.DisplayAlerts = True

    End With
Worsheets("Feuil1").Range("A1").Resize(UBound(datas, 1), UBound(datas, 2)) = datas            'MODIFIE - A ADAPTER : Worsheets("Feuil1").Range("A1")

par :

    With wsTicker
        .AutoFilterMode = False
        .Range("A2").AutoFilter Field:=1, Criteria1:=">=" & Format(Datedebut, "mm/dd/yyyy"), _
        Operator:=xlAnd, Criteria2:="<=" & Format(Datefin, "mm/dd/yyyy"), VisibleDropDown:=False
        On Error Resume Next
        Set Rng = .AutoFilter.Range.Cells.SpecialCells(xlCellTypeVisible)
        On Error Goto 0
    End With
If Not Rng Is Nothing Then
    With wbTicker.Worksheets.Add

        Rng.Copy .Range("A1")
        datas = .UsedRange.Value                                     'MODIFIE
        Application.DisplayAlerts = False
        .Delete
        Application.DisplayAlerts = True

    End With
Worsheets("Feuil1").Range("A1").Resize(UBound(datas, 1), UBound(datas, 2)) = datas            'MODIFIE - A ADAPTER : Worsheets("Feuil1").Range("A1")
Else
    MsgBox "Filtre sans résultat"
End If
Le 03/09/2020 à 12:08

Salut Franck,

D'accord je comprends mieux mais ça va à l'encontre de ce que je cherche à faire dans ce cas précis :/

donc une formule(ticker, date1, date2) à rentrer dans n'importe quelle cellule et qui sort un tableau , je me suis entêtée à trouver une solution hihi

Je me suis donc lancé dans l'idée d'inclure une procédure dans un fonction afin d'inscrire un résultat dans les cellules et j'arrive à ceci

Public Sub dataHistosV1(ticker As String, Datedebut As String, Datefin As String, wb As Workbook, ws As Worksheet, wc As Range)    

Application.ScreenUpdating = False

Dim FilePath As String
Dim wbTicker As Workbook
Dim wsTicker As Worksheet
Dim Rng As Range
Dim datas

FilePath = "C:\" & ticker & ".xlsx"

Set wbTicker = Workbooks.Open(FilePath)
Set wsTicker = wbTicker.Sheets("Feuil1")

    With wsTicker
        .AutoFilterMode = False
        .Range("A2").AutoFilter Field:=1, Criteria1:=">=" & Format(Datedebut, "mm/dd/yyyy"), _
        Operator:=xlAnd, Criteria2:="<=" & Format(Datefin, "mm/dd/yyyy"), VisibleDropDown:=False
        Set Rng = .AutoFilter.Range.Cells.SpecialCells(xlCellTypeVisible)

    End With

    With wbTicker.Worksheets.Add

        Rng.Copy .Range("A1")
        datas = .UsedRange.Value
        Application.DisplayAlerts = False
        .Delete
        Application.DisplayAlerts = True

    End With

Workbooks(wb.Name).Sheets(ws.Name).Range(wc.Address).Resize(UBound(datas, 1), UBound(datas, 2)).Value = datas

wbTicker.Close SaveChanges:=False
Application.ScreenUpdating = True

End Sub

et du coup avec une fonction comme ceci

Function testFinale(t As String, Date1 As String, Date2 As String)

Dim classeur As Workbook, feuille As Worksheet, cellule As Range

Set classeur = ActiveWorkbook
Set feuille = ActiveSheet
Set cellule = ActiveCell

  Call dataHistosV1(t, Date1, Date2, classeur, feuille, cellule)
End Function

Maintenant, une procédure test qui fonctionne mais qui ne retourne pas le tableau dans la cellule A1 mais dans la cellule active(c'est voulu)

Sub test()

Range("A1").Value = testFinale("MSDEWIN", "06/22/20", "07/07/20")
End Sub

Mais j'essaye ma fonction sur excel et la... pas de résultat!

Mais la procédure de test est censé être la même que rentrer une formule excel dans une cellule ou je suis à l'ouest ?

Merci encore Franck de prendre le temps, j'ai beaucoup apprise!!

Lucy

Le 03/09/2020 à 12:09

Hello Jean-Eric,

Merci pour la remarque!! Je vais inclure un test d'existence dans ce cas

Si tu as d'autres remarques n'hésites pas

Lucy

Le 03/09/2020 à 14:31

Re Franck,

Je n'ai pas vu ta proposition de gestion d'erreur mais merci beaucoup !

Pour l'instant, je ne maîtrise pas encore bien ce sujet, je vais m'inspirer de ta proposition pour la suite

Lucy

Le 03/09/2020 à 15:05

En fait, la suite va être de nous expliquer ce que tu veux...

de A à Z stp...

EDIT : Par exemple :

Je veux importer, dans mon fichier macro.xlsm, les données du classeur ticker1, ou ticker2, ou ticker18, données préalablement filtrées selon 2 critères de date.

Le 03/09/2020 à 15:50

Re Franck,

Désolée je ne suis pas montrée très claire ^^'

Le but est d'avoir une fonction excel qui permet de récupérer les données d'un fichier entre deux dates et le grand final en faire une macro complémentaire utilisable sur n'importe quelle classeur!

--> datahisto(ticker, dateDebut, dateFin) avec le ticker qui est le nom du fichier

quand je dis récupérer c'est afficher le tableau de données filtrés venant du fichier, en tant résultat de la fonction excel ( d'ou le fais que je veuille récupérer la cellule active !)

donc ici je devrais rentrer la fonction dataHisto( ticker; 22/06/2020; 07/07/2020) dans une cellule excel et les données filtrés s'affichent à partir de la même cellule

image

Par exemple, rentrer la fonction dans la cellule A1 et avoir comme résultat ceci

image

J'ai refais l'explication entière( pour les potentielles arrivants :)), si tu as besoin d'autres choses hésites pas

Merci encore! a toute a l'heure :)

Lucy

Le 03/09/2020 à 16:03

Bonjour,

@Lucy,

Peux-tu indiquer ta version Excel dans ton profil ?

Cdlt

Le 03/09/2020 à 16:10

Tout d'abord, un peu de lecture (en anglais)...

https://exceloffthegrid.com/dynamic-arrays-and-vba-user-defined-functions-udfs/

Rechercher des sujets similaires à "fonction qui recupere donnees filtres sort tableau comme resultat"