时间戳

首页 > 解决方案 > 需要循环帮助

excel - 需要循环帮助

问题描述

我在 Excel 电子表格的单元格 A1 中有 400 个股票代码的列表。然后我去一个宏并加载这个网站：

https://finviz.com/quote.ashx?t= " & Range("A1").Value

下面的宏 parsehtml_0 将数据从 400 个快照库存表中提取到 excel 中。结果从电子表格的第 1-400 行开始加载。

问题是 400 是您可以在 1 页上引入的快照库存表的限制，而我还有更多。

因此，我必须在单元格 A2 中创建第二个宏 parsehtml_1，其中包含 400 个以上的股票代码，以通过加载此网站来加载 400 个以上的股票代码：

https://finviz.com/quote.ashx?t= " & Range("A2").Value

这些结果从第 401 行开始加载到第 800 行。

我的问题是，由于大部分代码都是重复的，有没有办法运行循环来减少代码和宏的数量。非常感谢。

Public Sub parsehtml_0()
    Dim http As Object, html As New HTMLDocument, topics As Object, titleElem As Object, titleElem2 As Object, detailsElem As Object, topic As HTMLHtmlElement
    Dim i As Integer
    URL = "https://finviz.com/quote.ashx?t=" & Range("A1").Value
    Set http = CreateObject("MSXML2.XMLHTTP")
    http.Open "GET", URL, False
    http.send
    html.body.innerHTML = http.responseText
    Set topics = html.getElementsByClassName("snapshot-table2")
    i = 1
    For Each topic In topics
    Set titleElem = topic.getElementsByTagName("tr")(2)
    Set titleElem2 = topic.getElementsByTagName("td")(1)
    Sheets(1).Cells(i, 3).Value = titleElem.getElementsByTagName("b")(0).innerText
    Set titleElem = topic.getElementsByTagName("tr")(3)
    Set titleElem2 = topic.getElementsByTagName("td")(2)
    Sheets(1).Cells(i, 4).Value = titleElem.getElementsByTagName("b")(0).innerText
    i = i + 1
    Next
    Set topics = html.getElementsByClassName("fullview-title")
    i = 1
    For Each topic In topics
    Set titleElem = topic.getElementsByTagName("tr")(0)
    Set titleElem2 = topic.getElementsByTagName("td")(0)
    Sheets(1).Cells(i, 2).Value = titleElem.getElementsByTagName("a")(0).innerText
    i = i + 1
    Next

    End Sub


Public Sub parsehtml_1()
Dim http As Object, html As New HTMLDocument, topics As Object, titleElem As Object, titleElem2 As Object, detailsElem As Object, topic As HTMLHtmlElement
Dim i As Integer
URL = "https://finviz.com/quote.ashx?t=" & Range("A2").Value
Set http = CreateObject("MSXML2.XMLHTTP")
http.Open "GET", URL, False
http.send
html.body.innerHTML = http.responseText
Set topics = html.getElementsByClassName("snapshot-table2")
i = 401
For Each topic In topics
Set titleElem = topic.getElementsByTagName("tr")(2)
Set titleElem2 = topic.getElementsByTagName("td")(1)
Sheets(1).Cells(i, 3).Value = titleElem.getElementsByTagName("b")(0).innerText
Set titleElem = topic.getElementsByTagName("tr")(3)
Set titleElem2 = topic.getElementsByTagName("td")(2)
Sheets(1).Cells(i, 4).Value = titleElem.getElementsByTagName("b")(0).innerText
i = i + 1
Next
Set topics = html.getElementsByClassName("fullview-title")
i = 401
For Each topic In topics
Set titleElem = topic.getElementsByTagName("tr")(0)
Set titleElem2 = topic.getElementsByTagName("td")(0)
Sheets(1).Cells(i, 2).Value = titleElem.getElementsByTagName("a")(0).innerText
i = i + 1
Next

End Sub

当我添加该代码时，请参见下文，宏 parsehtml 消失。如果我仍然运行代码或运行加载程序，我会在这一行收到错误，并突出显示粗体部分。

Dim http As Object**, html As New HTMLDocument**, topics As Object, titleElem As Object, titleElem2 As Object, detailsElem As Object, topic As HTMLHtmlElement

Public Sub parsehtml(page As String)
    Dim http As Object**, html As New HTMLDocument**, topics As Object, titleElem As Object, titleElem2 As Object, detailsElem As Object, topic As HTMLHtmlElement
    Dim i As Integer
    URL = "https://finviz.com/quote.ashx?t=" & page
    Set http = CreateObject("MSXML2.XMLHTTP")
    http.Open "GET", URL, False
    http.send
    html.body.innerHTML = http.responseText
    Set topics = html.getElementsByClassName("snapshot-table2")
    i = 1
    For Each topic In topics
    Set titleElem = topic.getElementsByTagName("tr")(2)
    Set titleElem2 = topic.getElementsByTagName("td")(1)
    Sheets(1).Cells(i, 3).Value = titleElem.getElementsByTagName("b")(0).innerText
    Set titleElem = topic.getElementsByTagName("tr")(3)
    Set titleElem2 = topic.getElementsByTagName("td")(2)
    Sheets(1).Cells(i, 4).Value = titleElem.getElementsByTagName("b")(0).innerText
    i = i + 1
    Next
    Set topics = html.getElementsByClassName("fullview-title")
    i = 1
    For Each topic In topics
    Set titleElem = topic.getElementsByTagName("tr")(0)
    Set titleElem2 = topic.getElementsByTagName("td")(0)
    Sheets(1).Cells(i, 2).Value = titleElem.getElementsByTagName("a")(0).innerText
    i = i + 1
    Next

    End Sub

    Sub Loader()
    parsehtml Range("A1").Value
    parsehtml Range("A2").Value

    End Sub

标签： excelvba

解决方案

在您的子程序中使用参数。

请参阅Microsoft 文档和此附加资源。

而不是打电话

Public Sub parsehtml_0()

你应该打电话

Public Sub parsehtml(page as String)

然后你可以在你的 Sub 中更改一行：

URL = "https://finviz.com/quote.ashx?t=" & Range("A1").Value

变成：

URL = "https://finviz.com/quote.ashx?t=" & page

从那里，您可以创建一个初始 Sub 处理循环任意多次：

Sub Loader() 
  parsehtml Range("A1").Value
  parsehtml Range("A2").Value
End Sub

只需两个条目，就可以了；如果您继续有很多页面要加载，您可以研究如何用生成的数字替换 A1 并将负载包装在一个循环中。

为了让 Excel 找到HTMLDocument对象，需要一个引用。添加参考 VBE > 工具 > 参考 > HTML 对象库（根据 QHarr 的评论）。

MS Excel 对 HTML ObjectLibrary 的引用

您的主体代码当前重用了相同的空间。您可以将代码移动到工作簿模块并将每个页面的输出分配给不同的工作表，但最简单的方法是简单地将计数器变量设为i静态变量。

代替：

Dim i As Integer

和：

Static i As Integer

这将保留i跨次运行的值。请注意，当您关闭工作簿时，该值将丢失。如果要跨该边界保留值，只需将计数器分配给一个单元格 - Range("B1").Value = i。

推荐阅读