AW: Update von Excel-Datei per Makro
15.11.2006 14:12:27
Excel-Datei
Hi Lena
lach (sorry)..aber wie soll ich dir das - kurz - erklären, wenn du von VBA (noch) nicht sooo viel Ahnung hast? :-)
Ich versuch es mal so:
Ausgehend von deiner Bsp-Datei ist der folgende Code entstanden (nun mit Erklär-Text)
Sub WebImport()
'dieses Makro funktioniert nur mit der Yahoo-Seite
Dim lstrURL As String, liDurchlauf As Integer, lstrADR As String
'an die Variable lstrURL wird die erste Web-Adresse übergeben, aus der direkt der erste
'Aktienwert (hier für Allianz) übernommen wird
lstrURL = <a href=""http://de.finance.yahoo.com/q?s=ADS.DE"">"http://de.finance.yahoo.com/q?s=ADS.DE"</a>
'lstrADR erhält die Zelle, in die der erste Wert eingetragen werden soll
'diese Zelle musst du für deine Original-Datei wohl anpassen
lstrADR = "D6"
'da in der Bsp-Datei 3 Aktienwerte benötigt werden, wird mit For...
'eine Schleife gestartet, die 3x wiederholt wird
'auch diesen Wert musst du wohl anpassen, wenn mehr als 3 Aktinwerte erfragt werden sollen
For liDurchlauf = 1 To 3
'von With bis End With muss fast nichts angepasst werden
'diese Zeilen hab ich mit dem Makro-Recorder aufgezeichnet und angepasst
'geändert werden muss von dir vielleicht in der 2. Zeile "H1"
'"H1" bezeichnet die Starthilfszelle, in die die Werte aus der WEB-Abfrage
'erst mal zwischengespeichert werden
'verwende für "H" eine Spalte, die von dir nicht benutzt wird
'aber ändere nicht die 1
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;" & lstrURL, Destination:=Range("H1"))
.Name = "q?s=ADS.DE_1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "25"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
With ActiveSheet
'wenn du oben "H" geändert hast, musst du hier auch "I" ändern
'trage für "I" den rechten Nachbarbuchstaben ein, den du in "H" geändert hast
.Range(lstrADR).Value = Range("I1").Value
End With
'hier ändern sich jetzt in Abhängigkeit von der aktuellen webabfrage-adresse
'sowohl die zunächst gültige webabfrage-adresse, als auch die Zelle, in die
'der nächste Wert geschrieben werden soll
'wenn noch weitere Aktienwerte hinzu kommen sollen, dann schau dir den
'3. Eintrag als Muster an
If lstrURL = <a href=""http://de.finance.yahoo.com/q?s=ADS.DE"">"http://de.finance.yahoo.com/q?s=ADS.DE"</a> Then
lstrURL = <a href=""http://de.finance.yahoo.com/q?s=BAY.DE"">"http://de.finance.yahoo.com/q?s=BAY.DE"</a>
lstrADR = "D7"
End If
If lstrURL = <a href=""http://de.finance.yahoo.com/q?s=BAY.DE"">"http://de.finance.yahoo.com/q?s=BAY.DE"</a> Then
lstrURL = <a href=""http://de.finance.yahoo.com/q?s=DCX.DE"">"http://de.finance.yahoo.com/q?s=DCX.DE"</a>
lstrADR = "D8"
End If
' If lstrURL = <a href=""http://de.finance.yahoo.com/q?s=DCX.DE"">"http://de.finance.yahoo.com/q?s=DCX.DE"</a> Then
' lstrURL = <a href=""http://naechsteWEB-AbfrageAdresse"">"http://naechsteWEB-AbfrageAdresse"</a>
' lstrADR = "D9"
' End If
With ActiveSheet
'hier wird der Hilfsbereich wieder gelöscht, damit die Daten
'der nächsten WEB-Abfrage eingetragen werden können
'wenn du oben "H" geändert hast, musst du auch hier entsprechend
'anpassen
.Range("H1:I8").Value = ""
End With
Next
End Sub
Du kannst diesen Code mit Erklärungen ja gegen den alten Code austauschen.
Dein Hinweis, dass du mehrere ungültige Webanfrage wegklicken musst, verstehe ich (noch) nicht, da ich eben den Code noch mal ohne Probleme testete.
Die 3 Aktienwerte wurden klaglos eingetragen.
Konnte ich helfen?
Ciao
Thorsten