Question

我有一个代码可以从Marketwatch.com网站上的表格中提取共同基金返还数据，但似乎他们已经更改了页面和表格的名称，以及我似乎无法弄明白和/或拉取数据。

一个例子是：marketwatch.com/investing/fund/vfinx

在我看来喜欢表名class = "table.table.table--primary.align--right.c6.j-totalReturns"

不起作用。我只试过＆＃34; totalReturns＆＃34;，但那也没有。

连连呢？谢谢！

编辑：所以这里有一些我正在使用的代码

Dim oHTML       As Object
Dim oTable      As Object
Dim x           As Long
Dim Y           As Long
Dim vData       As Variant

Set oHTML = CreateObject("HTMLFile")

With CreateObject("WinHTTP.WinHTTPRequest.5.1")
.Open "GET", "http://www.marketwatch.com/investing/fund/" & 
ActiveCell.Value, False
.send
oHTML.body.innerhtml = .responsetext
End With

For Each oTable In oHTML.Getelementsbytagname("table")
If oTable.classname = "fundstable" Then
    ReDim vData(1 To oTable.Rows.Length, 1 To oTable.Rows(1).Cells.Length)

        For x = 1 To UBound(vData)
        For Y = 1 To UBound(vData, 2)
            vData(x, Y) = oTable.Rows(x - 1).Cells(Y - 1).innertext
        Next Y
        Next x

    With ActiveCell.Offset(1, 0)
    .Resize(UBound(vData), UBound(vData, 2)).Value = vData
    End With
Exit For
End If
Next oTable

Next Z

所以在工作表上，我会在下面分开十行间隔的几个代码，然后我的宏会下降，为每个代码拉出图表，然后我会有单元格引用被拉的数据。同样，我唯一的问题是桌子没有被命名为＆＃34; fundstable＆＃34;更多。再一次，你的方法有效，但我不能干净利落地工作 - 即插入数据开始添加列（因此移动其他单元格）。想法？

Answer 1

以下代码将创建一个新工作表，将查询表放在新工作表上，将查询表复制到旧工作表（不要将任何东西推到一边），然后删除新工作表。或者，您可以使用查询表和＆＃34; querytable.refresh＆＃34;保留新工作表。它在需要的时候。这样做应该更新您复制它的表格。

    Sub GetDataFromInternetFirstTimeAndCreateNewSheet()
    Dim ws As Worksheet
    Dim actSh As Worksheet
    Dim numRows As Long, numCols As Long

    Application.ScreenUpdating = False

    '   Destroy this sheet if exists
    On Error Resume Next
    Application.DisplayAlerts = False
    ActiveWorkbook.Worksheets("MarketWatch_Query").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0

    Set actSh = ActiveSheet
    '   Create the new sheet and name it
    Set ws = Sheets.Add
    ws.Name = "MarketWatch_Query"

        With ws.QueryTables.Add(Connection:= _
            "URL;http://www.marketwatch.com/investing/index/gdow" _
            , Destination:=Range("$A$1"))
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .BackgroundQuery = True
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .WebSelectionType = xlAllTables
'  You can get specific tables only by changing xlEntirePage to the following
'           .WebSelectionType = xlSpecifiedTables  'xlAllTables 'xlEntirePage
'           .WebTables = "1,2"
            .WebFormatting = xlWebFormattingNone
            .WebPreFormattedTextToColumns = True
            .WebConsecutiveDelimitersAsOne = True
            .WebSingleBlockTextImport = False
            .WebDisableDateRecognition = False
            .WebDisableRedirections = False
            .Refresh BackgroundQuery:=False
        End With

    numRows = ws.QueryTables(1).ResultRange.Rows.Count
    numCols = ws.QueryTables(1).ResultRange.Columns.Count
    ws.Activate
    '   Copy the table to any sheet you want to and it will not push anything aside
    '   However it will overwrite cells so put it somewhere that nothing will be overwritten
    On Error Resume Next
    Application.DisplayAlerts = False
    ws.Range(Cells(1, 1), Cells(numRows, numCols)).Copy Destination:=Sheet1.Cells(10, 1)
    Application.DisplayAlerts = True
    On Error GoTo 0

    '   Then destroy the new sheet
    On Error Resume Next
    Application.DisplayAlerts = False
    ActiveWorkbook.Worksheets("MarketWatch_Query").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0

    Application.ScreenUpdating = True

End Sub

Answer 2

这对我有用。找到here：

获得数据后，您可以按照自己喜欢的方式对其进行格式化

    Sub Macro1()
    '
    ' Macro1 Macro
    '

    '
        With ActiveSheet.QueryTables.Add(Connection:= _
            "URL;http://www.marketwatch.com/investing/index/gdow" _
            , Destination:=Range("$A$1"))
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .BackgroundQuery = True
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .WebSelectionType = xlEntirePage
'  You can get specific tables only by changing xlEntirePage to the following        
'           .WebSelectionType = xlSpecifiedTables  'xlAllTables 'xlEntirePage
'           .WebTables = "1,2"
            .WebFormatting = xlWebFormattingNone
            .WebPreFormattedTextToColumns = True
            .WebConsecutiveDelimitersAsOne = True
            .WebSingleBlockTextImport = False
            .WebDisableDateRecognition = False
            .WebDisableRedirections = False
            .Refresh BackgroundQuery:=False
        End With

    End Sub

在HTML

2 个答案: