我正在尝试从moneycontrol.com下载历史股票价格。这是我的代码...当前代码从每个网页中提取数据并每次粘贴到新的工作表中。
但是,我想将数据附加到下一个空白行,而不是在新工作表中创建数据。有人可以帮帮我吗?
Private Const URL_TEMPLATE As String = "URL;http://www.moneycontrol.com/stocks/hist_stock_result.php?sc_id=RI&pno={0}&hdn=daily&fdt=2000-01-01&todt=2015-12-31"
Private Const NUMBER_OF_PAGES As Byte = 1
Sub DataDownload()
Dim page As Byte
Dim queryTableObject As QueryTable
Dim url As String
For page = 1 To NUMBER_OF_PAGES
url = VBA.Strings.Replace(URL_TEMPLATE, "{0}", page)
Set queryTableObject = ActiveSheet.QueryTables.Add(Connection:=url, Destination:=ThisWorkbook.Worksheets.Add.[a1])
queryTableObject.FieldNames = True
queryTableObject.RowNumbers = False
queryTableObject.FillAdjacentFormulas = False
queryTableObject.PreserveFormatting = True
queryTableObject.RefreshOnFileOpen = True
queryTableObject.BackgroundQuery = True
queryTableObject.RefreshStyle = xlOverwriteCells
queryTableObject.SavePassword = False
queryTableObject.SaveData = False
queryTableObject.AdjustColumnWidth = False
queryTableObject.RefreshPeriod = 0
queryTableObject.WebSelectionType = xlSpecifiedTables
queryTableObject.WebFormatting = xlWebFormattingNone
queryTableObject.WebTables = "4"
queryTableObject.WebPreFormattedTextToColumns = True
queryTableObject.WebConsecutiveDelimitersAsOne = True
queryTableObject.WebSingleBlockTextImport = True
queryTableObject.WebDisableDateRecognition = True
queryTableObject.WebDisableRedirections = True
queryTableObject.Refresh BackgroundQuery:=False
Next page
End Sub
答案 0 :(得分:1)
未经测试,但尝试添加以下行:
Dim ws As Worksheet
Set ws = Thisworkbook.Sheets("SheetName") ' change to your actual sheetname
然后改变这一行:
Set queryTableObject = ActiveSheet.QueryTables.Add(Connection:=url, _
Destination:=ThisWorkbook.Worksheets.Add.[a1])
到这一行:
Set queryTableObject = ws.QueryTables.Add(Connection:=URL, _
Destination:=ws.Range("A:A").Find("*", , , , , xlPrevious).Offset(1, 0))
这样,数据将被添加到您始终指定的工作表上以及第一个空白行。