Question

我想通过在第一列中输入设置数字并让excel在网上查找它们并填写诸如设置名称，积木数量，...等详细信息来列出我的乐高玩具的清单。

这是我的代码：

Option Explicit  
Sub BrickLinkDataExtraction()

    Dim x As Integer
    Dim i As Integer
    Dim IE As New InternetExplorer

    For i = 5 To Cells(Rows.Count, 1).End(xlUp).Row

        IE.navigate "https://brickset.com/sets/" & Cells(RowIndex:=i, columnindex:=1).Value
        IE.Visible = False

        Do
            DoEvents
        Loop Until IE.readyState = READYSTATE_COMPLETE 'hier moet ik zeggen "tot rijen vol zijn", zoiets? IsEmpty(Range("i+1" & "A"))

        Dim Doc As HTMLDocument
        Set Doc = IE.document
        Dim NAME As String
        NAME = Trim(Doc.getElementsByTagName("dd")(1).innerText)
        Dim THEME As String
        THEME = Trim(Doc.getElementsByTagName("dd")(4).innerText)
        Dim YEAR As String
        YEAR = Trim(Doc.getElementsByTagName("dd")(6).innerText)
        Dim BRICKS As String
        BRICKS = Trim(Doc.getElementsByTagName("dd")(8).innerText)
        Dim MINIFIGS As String
        MINIFIGS = Trim(Doc.getElementsByTagName("dd")(9).innerText)

        If IsEmpty(Cells(RowIndex:=i, columnindex:=2)) Then
            Cells(RowIndex:=i, columnindex:=2).Value = NAME
        End If

        If IsEmpty(Cells(RowIndex:=i, columnindex:=3)) Then
            Cells(RowIndex:=i, columnindex:=3).Value = BRICKS
        End If

        If IsEmpty(Cells(RowIndex:=i, columnindex:=4)) Then
            Cells(RowIndex:=i, columnindex:=4).Value = MINIFIGS
        End If

        If IsEmpty(Cells(RowIndex:=i, columnindex:=5)) Then
            Cells(RowIndex:=i, columnindex:=5).Value = THEME
        End If

        If IsEmpty(Cells(RowIndex:=i, columnindex:=6)) Then
            Cells(RowIndex:=i, columnindex:=6).Value = YEAR
        End If

    Next

    IE.Quit

    Cells.Columns.AutoFit

End Sub

这可以正常工作，直到代码到达一个没有相同顺序标记的集合或不使用minifigs为止。然后我在电子表格中得到了错误的信息。

我如何指定我需要使用“名称”作为别名，而不是指定第二，第五，...？

例如https://brickset.com/sets/10224可以正常工作；但是https://brickset.com/sets/10262在minifigs列中输入原始零售价格。

还有，有没有一种方法可以优化代码，因此它不需要花很长时间运行？

Answer 1

我将切换到XMLHTTP GET请求以更快地检索您想要的信息。

HTML并不适合您选择发现的感兴趣项的好方法。如果每个页面上的项目数不同，则位置匹配就会失效。

一致的模式是项目名称（标记为dt）和值（标记为dd）成对出现。例如，"Name"随附"Town Hall"；因此您可以在一个dt中收集nodeList个元素，在另一个dd中收集{循环执行第一个检查，以确保所需的项目名称存在。项目名称列表的长度将与关联值列表的长度匹配，因此您只需循环这些项目并使用与找到所需项目名称的位置相同的索引访问值nodeList。

过程：

我将感兴趣的集合存储在数组sets中，该数组是我从Sheet1列A中读取的。我对该数组进行循环，将当前集合号连接到基本url常量上，以获取乐高套组的实际网址。 XMLHTTP GET Request是针对该网址发出的。

使用了一个辅助函数GetHTMLDoc来处理请求，并返回一个带有HTML页面的HTMLDocument。

我使用了一个附加的辅助功能GetItemsInfo，以便从存储在最近返回的HTMLDocument中的HTML页面中检索所需的各种项目。它创建一个字典resultsDict，其键是感兴趣的项，即"Name","Theme"等。这些键具有初始vbNullstring值，如果在页面上找到该键，则该值字典中的那个键被页面上找到的值覆盖。

每个页面的结果字典都存储在数组results中，稍后我将其循环以将结果写出到页面中。

待办事项：

您可以通过一些其他错误处理来开发此代码。例如，当GET请求由于找不到页面而无法返回所需的HTML或处理开始行和结束行之间的A列中的空白单元格时。
您可以探索免费的SOAP based API。我不确定它是否提供了文档最初的摘要中所有有用的内容。
处理返回字符串中可能不需要的字符，例如如果未处理，詹姆斯·邦德标题中的Â会出现在书写纸上。在这种情况下，我使用了Replace$(info(i).innerText, Chr$(194), vbNullString)。

CSS SELECTORS:

我使用这样一个事实，即每个感兴趣的dd标签都在感兴趣的父dt标签中以dl标签开头：

这意味着我可以使用CSS选择器来定位页面样式，从而使用父dt标签收集所有dl标签。然后，我遍历返回的nodeList，并根据我的字典键检查每个节点的innerText值。如果它们匹配（存在），那么我知道我想要的项目存在于页面上。假设在父元素中每个dd标签都有一个匹配的dt标签，我知道我想要的值将在nodeList中的相同索引处，我可以通过抓取所有带有父标签dd的{{1}}标签。然后，我可以用找到的值覆盖字典值。

我应用dl的CSS选择器，以返回带有父项dl dt标记的dt标记的所有元素。通过dl的{{1}}方法应用此选择器。这将返回一个.querySelectorAll，其HTMLDocument可以遍历以按索引从0开始访问各个节点。这是nodeList nodeList-它包含每个项目名称，例如.Length等

示例CSS查询：

对值使用类似的CSS查询，并使用"titles"返回"Name","Theme"，我称为nodeList

VBA：

info

结果：

参考（VBE>工具>参考）：

Microsoft HTML对象库

无法将正确的网站数据导入excel

1 个答案: