Hello la team,

Je me confronte à un petit problème depuis un moment. J'ai fais une fonction excel permettant de récupérer des données( données financières : donc date en 1er colonne et le reste) sur d'autres fichiers, via une filtre de date avec une date de début et une date de fin.

L'objectif final étant de mettre cette fonction dans une macro complémentaire afin d’être utilisé sur l'ensemble des classeurs

Le problème est que je n'arrive pas à la faire fonctionner sur excel( ça me sort un value), je suis obligé de passer par une procédure ( worksheet change ) mais cette méthode ne convient pas vraiment, il me faudrait une fonction !

C'est une imitation d'une fonction bloomberg type BDH pour ceux qui connaissent!

Auriez-vous une feinte ?

J'ai mise un fichier avec la macro et un fichier "ticker1" : c'est le fichier qui contient les données que la fonction doit interroger

Voici voulou, j'espère que j'étais assez claire

Merci à vous

Lucy

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
 
 
Public Function FichierExiste(MonFichier As String)
 
   If MonFichier <> "" And Len(Dir(MonFichier)) > 0 Then
      FichierExiste = True
   Else
      FichierExiste = False
   End If
End Function
 
'-------------------------------------------------------------------------------------------------------
Public Function getdata(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
Dim datas()
 
FilePath = "C:\" & ticker & ".xlsx"
 
If FichierExiste(FilePath) = False Then
        MsgBox "Le fichier " & ticker & " n'existe pas dans la base, veuillez le créer!"
        Exit Function
 
Else:
    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
            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
            Application.DisplayAlerts = False
            .Delete
            Application.DisplayAlerts = True
 
        End With
    getdata = datas
    Else
        MsgBox "Filtre sans résultat"
    End If
    wbTicker.Close SaveChanges:=False
 
End If
 
Application.ScreenUpdating = True
 
Set wbTicker = Nothing: Set wsTicker = Nothing:
 
End Function
 
'---------------------Partie Worksheet Change------------
 
 
 
Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Excel.Range)
 
Dim datas As Variant
Dim ContenuInitial As String
Dim a() As String
Dim ticker As String, d1 As String, d2 As String
 
If Target.Count > 1 Then
Exit Sub
End If
ContenuInitial = Target.Value
 
If ContenuInitial Like "*,*,*" Then
    a() = Split(ContenuInitial, ",")
    ticker = a(0)
    d1 = a(1)
    d2 = a(2)
 
    datas = getdata(ticker, d1, d2)
    If datas <> "" Then
    Target.Resize(UBound(datas, 1), UBound(datas, 2)).Value = datas
    Else: Exit Sub
    End If
 
Else: Exit Sub
End If
 
End Sub
macro.xlsmticker1 (2).xlsx