Sub Abruf()
Dim wks As Worksheet
Dim var As Variant
Dim sWkn As String, sQuery As String
Application.ScreenUpdating = False
Set wks = ActiveSheet
sWkn = InputBox( _
prompt:="WKN-Nr.:", _
Title:="Web-Abfrage", _
Default:="840400")
If sWkn = "" Then Exit Sub
sQuery = "http://de.finance.yahoo.com/q?m=*&s=" & sWkn & "&d=v1"
Worksheets.Add after:=Worksheets(Worksheets.Count)
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;" & sQuery, _
Destination:=Range("A1"))
.Refresh BackgroundQuery:=False
End With
var = Application.Match(sWkn & "*", Columns(1), 0)
wks.Range("A2").Value = Cells(var, 2).Value
wks.Range("B2").Value = Cells(var, 1).Value
wks.Range("C2").Value = Cells(var, 3).Value
wks.Range("D2").Value = Cells(var, 5).Value
wks.Range("E2").Value = Cells(var, 6).Value
wks.Range("F2").Value = Cells(var, 7).Value
wks.Range("G2").Value = Cells(var, 8).Value
wks.Range("H2").Value = Now
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
Worksheets("Daten").Select
Range("A1").Select
Columns("A:G").AutoFit
Application.ScreenUpdating = True
End Sub
Sub geht davon aus, dass Du in den Zellen A2, A3, A4 ... die gewünschte WKN einträgst. Alle WKN werden nacheinander abgefragt.
Die Ausgabe wurde um eine Spalte versetzt.
Sub Abruf()
Dim zeile As Integer
Dim wks As Worksheet
Dim var As Variant
Dim sWkn As String, sQuery As String
zeile = 2
sWkn = "1"
Do Until sWkn = ""
Worksheets("Daten").Select
sWkn = Cells(zeile, 1).Value
If sWkn = "" Then
Exit Do
End If
Application.ScreenUpdating = False
Set wks = ActiveSheet
sQuery = "http://de.finance.yahoo.com/q?m=*&s=" & sWkn & "&d=v1"
Worksheets.Add after:=Worksheets(Worksheets.Count)
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;" & sQuery, _
Destination:=Range("A1"))
.Refresh BackgroundQuery:=False
End With
var = Application.Match(sWkn & "*", Columns(1), 0)
wks.Cells(zeile, 2).Value = Cells(var, 2).Value
wks.Cells(zeile, 3).Value = Cells(var, 1).Value
wks.Cells(zeile, 3).Value = Cells(var, 3).Value
wks.Cells(zeile, 4).Value = Cells(var, 5).Value
wks.Cells(zeile, 5).Value = Cells(var, 6).Value
wks.Cells(zeile, 6).Value = Cells(var, 7).Value
wks.Cells(zeile, 7).Value = Cells(var, 8).Value
wks.Cells(zeile, 8).Value = Now
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
Worksheets("Daten").Select
Range("A1").Select
Columns("A:I").AutoFit
Application.ScreenUpdating = True
zeile = zeile + 1
Loop
End Sub
MfG
Andreas Eckmann
Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen