需要将数据附加到下一个空行而不是在新工作表中创建数据

时间:2015-03-21 06:00:58

标签: excel vba excel-vba

我正在尝试从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

1 个答案:

答案 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))

这样,数据将被添加到您始终指定的工作表上以及第一个空白行。