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
strLocalFile = ThisWorkbook.Path &
"\Bitcoin_"
& Format(
Date
,
"YYYYMMDD"
) &
".csv"
download_file = URLDownloadToFile(0, strURL, strLocalFile, 0, 0)
End
Function
Sub
sortierung()
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
Set
wksImport = Worksheets(
"Tabelle1"
)
i = 1: j = 1
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