Thema Datum  Von Nutzer Rating
Antwort
Rot VBA: Aktienkurse aktualisieren
12.06.2014 15:32:54 Gast39938
NotSolved

Ansicht des Beitrags:
Von:
Gast39938
Datum:
12.06.2014 15:32:54
Views:
1216
Rating: Antwort:
  Ja
Thema:
VBA: Aktienkurse aktualisieren
Hallo zusammen,
ich bastel gerade ein umfangreicheres VBA-Tool zur Portfoliooptimierung.
Zu Beginn habe ich 3 Aktienkurse bei yahoo Finance runtergeladen, und würde diese nun gerne jedesmal wenn das Tool lädt aktualisieren (bzw. noch besser ein Auswahlfeld damit verknüpfen).

Leider bekomme ich es nicht hin, den Code den ich dazu gefunden habe, so einzubeten dass es funktioniert:
 Sub test()

Dim Spalte As Integer
Dim startzeile As Integer
Dim endzeile As Integer
Dim numberws As Integer

On Error GoTo Fehler

Tabellenblatt = InputBox("Name des Tabellenblattes in der sich die Aktienkürzel von finance.yahoo.de befinden")
Spalte = InputBox("Nummer der Spalte in der sich die Aktienkürzel von finance.yahoo.de befinden")
startzeile = InputBox("Startzeilenummer der Aktienkürzel")
endzeile = InputBox("Endzeile der Aktienkürzel")


For n = startzeile To endzeile

x = Worksheets(Tabellenblatt).Cells(n, Spalte).Value

  ActiveWorkbook.Worksheets.Add After:=Worksheets(Worksheets.Count)
      With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;http://ichart.finance.yahoo.com/table.csv?s=" & x & "&d=" & Month(Date) & "&e=" & Day(Date) & "&f=" & Year(Date) & "&g=d&a=0&b=1&c=1900&ignore=.csv" _
        , Destination:=Range("$A$1"))
        .Name = "table.csv?s=BMW.DE&d=6&e=31&f=2012&g=d&a=0&b=1&c=2003&ignore="
        .FieldNames = True
        .RowNumbers = True
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlOverwriteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(5, 1, 1, 1, 1, 1, 1)
        .TextFileDecimalSeparator = "."
        .TextFileThousandsSeparator = ","
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
        
    End With
ActiveSheet.Name = x


ActiveWorkbook.Connections("table.csv?s=" & x & "&d=" & Month(Date) & "&e=" & Day(Date) & "&f=" & Year(Date) & "&g=d&a=0&b=1&c=1900&ignore=").Delete
ActiveSheet.QueryTables.Item(ActiveSheet.QueryTables.Count).Delete
ActiveSheet.ListObjects.Add(xlSrcRange, ActiveSheet.Range(ActiveSheet.Cells(1, 1), ActiveSheet.Cells(1, 7).End(xlDown)), , xlYes).Name = x

MsgBox "Die Kurse für " & x & " wurden erfolgreich in ein neues Tabellenblatt geladen."
Next n


Hier beginnt der Code meines VBA-Tools, bzw. was ich jetzt habe

Option Explicit
Option Base 1

Sub Test()
    
    Dim wb As Workbook:         Set wb = Workbooks("Gruppenassignment.xlsm")
    Dim wsBMW As Worksheet:     Set wsBMW = wb.Worksheets("BMW")
    Dim wsBASF As Worksheet:    Set wsBASF = wb.Worksheets("BASF")
    Dim wsRWE As Worksheet:     Set wsRWE = wb.Worksheets("RWE")
    
    'Tage, an denen nicht gehandelt wurde löschen
    Dim i As Integer, j As Integer, k As Integer
    Dim letzteZeileBMW As Long:    letzteZeileBMW = wsBMW.Cells(2, 6).End(xlDown).Row
    Dim lZBASF As Long:            lZBASF = wsBASF.Cells(2, 6).End(xlDown).Row
    Dim lZRWE As Long:             lZRWE = wsRWE.Cells(2, 6).End(xlDown).Row
    
    For i = 1 To letzteZeileBMW
        With wsBMW
        If .Cells(i, 6) = "0" Then
        .Rows(i).Delete
        End If
        End With
    Next i
    
    For j = 1 To lZBASF
        With wsBASF
        If .Cells(j, 6) = "0" Then
        .Rows(j).Delete
        End If
        End With
    Next j
    
    For k = 1 To lZRWE
        With wsRWE
        If .Cells(k, 6) = "0" Then
        .Rows(k).Delete
        End If
        End With
    Next k
    
    
End Sub

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:

 
 

  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot VBA: Aktienkurse aktualisieren
12.06.2014 15:32:54 Gast39938
NotSolved