Option Explicit
Private Declare Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" ( _
ByVal pCaller As Long, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As Long, _
ByVal lpfnCB As Long) As Long
Public Sub download_und_import_bitcoin_courses()
If download_file <> 0 Then
MsgBox "Problem beim herunterladen.", vbExclamation
Exit Sub
End If
Call import
Call sortierung
MsgBox "Import erfolgreich.", vbInformation
End Sub
Private Function download_file() As Long
Dim strURL As String
Dim strLocalFile As String
'Link zum Donwload
strURL = "http://www.quandl.com/api/v3/datasets/BITFINEX/BTCUSD.csv"
'Pfad für den Speicherort
strLocalFile = ThisWorkbook.Path & "\Bitcoin_" & Format(Date, "YYYYMMDD") & ".csv"
'Datei herunterladen und Status zurückgeben
download_file = URLDownloadToFile(0, strURL, strLocalFile, 0, 0)
End Function
Sub sortierung()
'
' sortierung Makro
'
'
Range("A1:H750").Select
ActiveWorkbook.Worksheets("Tabelle1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Tabelle1").Sort.SortFields.Add Key:=Range( _
"A2:A750"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Tabelle1").Sort
.SetRange Range("A1:H750")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
Private Sub import()
Dim fso As Object
Dim txtStream As Object
Dim i As Integer, j As Integer
Dim strPfad As String
Dim strDaten() As String
Dim wksImport As Worksheet
'Tabelle, in der importiert wird
Set wksImport = Worksheets("Tabelle1")
'Bereich in dem Eingefügt wird (1,1 = A1; 2,1 = A2..)
i = 1: j = 1
'Tabellenblatt leeren
wksImport.Cells.Clear
strPfad = ThisWorkbook.Path & "\Bitcoin_" & Format(Date, "YYYYMMDD") & ".csv"
Set fso = CreateObject("Scripting.FilesystemObject")
Set txtStream = fso.OpenTextfile(strPfad)
Do While Not txtStream.AtEndOfStream
strDaten() = Split(txtStream.ReadLine, ",")
For j = 0 To UBound(strDaten())
wksImport.Cells(i, j + 1) = strDaten(j)
Next j
i = i + 1
Loop
txtStream.Close
Set txtStream = Nothing
Set fso = Nothing
End Sub
Function durchschnitt(arr As Range) As Double
Dim v As Variant
Dim sum As Double
For Each v In arr
sum = sum + v
Next
durchschnitt = sum / arr.Count
End Function
Function RSI(arr As Range)
Dim up_day, down_day, ups, downs
Dim average_up, average_down
Dim RS, cellcount As Long
Dim cll As Range
ups = 0
up_day = 0
downs = 0
down_day = 0
cellcount = 0
For Each cll In arr
cellcount = cellcount + 1
If cellcount = arr.Count Then Exit For
If cll.Value >= cll.Offset(1, 0).Value Then
downs = downs + cll - cll.Offset(1, 0).Value
ElseIf cll.Value < cll.Offset(1, 0).Value Then
ups = ups + cll.Offset(1, 0).Value - cll.Value
End If
Next cll
average_up = ups / cellcount
average_down = downs / cellcount
RS = average_up / average_down
RSI = 100 - (100 / (1 + RS))
End Function