Question

这段代码在我第一次尝试时有效，但是当我尝试将它复制到Excel中的新宏并将表拉到另一张表时，它什么也没有生成。所以我想我需要关闭/释放我的对象。我做得对吗？你能看到为什么它不能为我拉另一张HTML表格的其他原因吗？谢谢！

Dim oHTML       As Object
Dim oTable      As Object
Dim x           As Long
Dim y           As Long
Dim vData       As Variant
Dim DataSheet As Worksheet

Set DataSheet = ActiveSheet
Set oHTML = CreateObject("HTMLFile")

With CreateObject("WinHTTP.WinHTTPRequest.5.1")
.Open "GET", "http://www.marketwatch.com/investing/fund/" & range("a1").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 Sheets(2).Range("A" & Rows.Count).End(xlUp).Offset(1)
        .Resize(UBound(vData), UBound(vData, 2)).Value = vData
    End With

End If
Next oTable

Set oHTML = Nothing
Set oTable = Nothing
Set htmlfile = Nothing

我应该开始，非常感谢你看看这个 - 我真的很感谢你的时间！

您修改过的代码可以正常工作......但是，我在第一个标签上再试一次。看起来我需要显示其余的代码，并更好地描述我尝试做的事情......

所以，我有多张表，每张都有不同类别的资金。我列出了所有这些，并且每个工作表都按照我希望显示的表格中的信息的方式进行格式化。因为当我拉桌子时，它不是我想要的格式，我的想法是将数据带入表2，然后自动将单元格从单元格2复制到单元格中我想要的单元格。

首先，我清除工作表2中的列：

Sheets("Sheet2").Select
Columns("A:T").Select
Range("A276").Activate
Selection.Delete Shift:=xlToLeft

然后我回到目标表（在这种情况下是大值表），并从单元格A49复制一个滚动条，并将其粘贴到工作表2，单元格A1中。

Sheets("Large Value").Select
Range("A1").Select
ActiveCell.Offset((48 + (Z * 10)), 0).Range("A1").Select
Selection.Copy
Sheets("Sheet2").Select
Range("A1").Select
ActiveSheet.Paste

然后我开始你的（或修改过的）代码。（上图）它带来了所需的表格，我开始将我想要的单元格复制回目标表格（同样，大值）

Cells.Find(What:="fund return", After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Activate

ActiveCell.Offset(1, 0).Range("A1").Select
Selection.Copy
Sheets("Large Value").Select
ActiveCell.Offset(1, 1).Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
For A = 1 To 4
Sheets("Sheet2").Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.Copy
Sheets("Large Value").Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Next A

Sheets("Sheet2").Select
ActiveCell.Offset(-4, 1).Range("A1").Select
Selection.Copy
Sheets("Large Value").Select
ActiveCell.Offset(-4, 1).Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
For B = 1 To 4
Sheets("Sheet2").Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.Copy
Sheets("Large Value").Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Next B

Sheets("Sheet2").Select
ActiveCell.Offset(-4, 1).Range("A1").Select
Selection.Copy
Sheets("Large Value").Select
ActiveCell.Offset(-4, 1).Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
For C = 1 To 4
Sheets("Sheet2").Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.Copy
Sheets("Large Value").Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Next C

Next Z

所以这是我第一次使用我的代码和修改后的代码。但是，只要我添加第二个标签，就说出＃34;大增长＆＃34;，然后复制相同的代码，只替换单词＆＃34; Value＆＃34;随着＆＃34;成长＆＃34;在整个代码中，它什么都没带回来。正确地复制了代码...实际上是第一个代码，但是当它查找＆＃34;基金回报＆＃34;时它没有带来任何错误，因为什么都没有。

所以我的想法是，在某种程度上，代码的中间部分与另一个宏混淆了。只要我删除第二个宏尝试和第二个选项卡，宏1（＆＃34;大值＆＃34;）就会再次运行。

但是现在我考虑一下，你的答案/提示是有道理的 - 而不是将所有内容都带入Sheet（2），将表格带入目标页面，比如单元格A1000 - 或者其他什么，只是一路走来，所以它从同一张纸上复印，而不是在纸张之间来回切换。我现在要尝试并报告回来！

好的 - 我想我越来越近了。但还有一个问题 - 如何从HTML中获取第一个表，而不是＆＃34; For Each＆＃34;。有两个表进入，第二个表覆盖第一个！

Answer 1

我们来试试吧。你的代码很好，没有理由不应该用类似的页面说它具有相同的结构。那么，我要做的是：

将对表格的引用（例如Sheet(2)）替换为HTTP请求响应的粘贴。修改后的代码下方（带注释的高亮显示）。
确保将宏放在正确的位置，即工作簿的专用模块中。要达到此目的，请打开VBA编辑器（视图/宏），然后在 VBAProject / Modules 下单击鼠标右键并插入模块。所以，只需复制并粘贴下面的代码即可。
确保基金的名称始终放在您想要结果的工作表的范围A1中;
确保链接（在浏览器上手动查看）实际上包含您查找的相同数据。

修改后的代码：

Sub UpdateThisSheet() 'working on the current sheet, you don't need to make X identical macros ;)

Dim oHTML       As Object
Dim oTable      As Object
Dim x           As Long
Dim y           As Long
Dim vData       As Variant
Dim DataSheet As Worksheet

Set DataSheet = ActiveSheet
Set oHTML = CreateObject("HTMLFile")

With CreateObject("WinHTTP.WinHTTPRequest.5.1")
.Open "GET", "http://www.marketwatch.com/investing/fund/" & ActiveSheet.Range("a1").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 ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1) 'data goes in the current sheet, not always in sheet 2 !
        .Resize(UBound(vData), UBound(vData, 2)).Value = vData
    End With

Exit For 'NEW LINE TO ESCAPE THE CODE ONCE THE FIRST TABLE HAS BEEN REPORTED

End If
Next oTable

Set oHTML = Nothing
Set oTable = Nothing
Set htmlfile = Nothing

End Sub

正确释放htmlfile对象？

1 个答案: