Excel 宏用于使用 excel 数据搜索网站并提取特定结果，然后循环获取另一个网站的下一个值答案

【问题标题】：Excel macro to search a website with excel data and extract specific results and then loop for next value for another webisteExcel 宏用于使用 excel 数据搜索网站并提取特定结果，然后循环获取另一个网站的下一个值
【发布时间】：2019-12-20 09:04:10
【问题描述】：

我已经复制了 Excel macro to search a website with excel data and extract specific results and then loop for next value 中的代码，尽管我在 URL_Get_SKU_Query1 = entityRange.Offset(0, 1).Value2 行出现错误，说明“未设置对象变量或块变量”

所以我只是想为另一个网站复制代码。此代码拉入特定文本并从网站中吐出一个值。

所以我想在表 1 中输入 MFR SKU：

名称 // SKU // 价格节水水龙头 // SS902BC

在我在工作表 2 上创建一个宏按钮并单击它之后

然后让它吐出价格。

所以结果如下：

名称 // SKU // 价格节水水龙头 // SS902BC // 979.08

我需要这个才能在网站上查找多个项目。

Sub LoopThroughBusinesses1()
    Dim i As Integer
    Dim SKU As String
    For i = 2 To Sheet1.UsedRange.Rows.Count
        SKU = Sheet1.Cells(i, 2)
        Sheet1.Cells(i, 3) = URL_Get_SKU_Query1(SKU)
    Next i
End Sub

Function URL_Get_SKU_Query1(strSearch As String) As String ' Change it from a Sub to a Function that returns the desired string
    ' strSearch = Range("a1") ' This is now passed as a parameter into the Function
    Dim entityRange As Range
    With Sheet2.QueryTables.Add( _
         Connection:="URL;https://www.neobits.com/SearchBySKU.aspx?SearchText=" & strSearch & "&safe=active", _
         Destination:=Sheet2.Range("A1"))        ' Change this destination to Sheet2

        .BackgroundQuery = True
        .TablesOnlyFromHTML = True
        .Refresh BackgroundQuery:=False
        .SaveData = True
    End With

    ' Find the Range that has "Price"
    Set entityRange = Sheet2.UsedRange.Find("Price")

    ' Then return the value of the cell to its' right
    URL_Get_SKU_Query1 = entityRange.Offset(0, 1).Value2

    ' Clear Sheet2 for the next run
    Sheet2.UsedRange.Delete

End Function

【问题讨论】：

也许为我们提供了一个完整的工作 url 和预期的结果？
请检查我对您帖子的编辑，看看它是否准确地代表了您想要的完整代码帖子。然后看看是否可以将代码量减少到演示问题所需的代码量。
您好，感谢您的输入，我已更改链接，以便将您定向到我最初找到代码的位置。我已经测试了链接中的代码，它工作正常，并提供了更多关于我希望代码做什么的信息。
你不能简单地假设你可以转移逻辑。您需要有效的网址。至少对我来说，构造 neobits.com/SearchBySKU.aspx?SearchText=SS902BC&safe=active 导致 404 页面未找到。除非我遗漏了某些东西（完全有可能），否则您的错误原因是无效的 url，这意味着您以后的选择器将无法找到。
从我使用 URL 的示例中；abr.business.gov.au/SearchByABN.aspx?SearchText= 工作正常，虽然我不确定 "SearchByABN.aspx?SearchText= 是什么意思，这种编码背后有什么原因吗？如果你愿意能够帮助我修改我的网址，使其正常工作，我将不胜感激。例如，当我进入 Excel 并执行宏时，我想从这个网址neobits.com/watersaver_faucet_ss902bc_ss902bc_p9597758.html 获得价格。

标签： excel vba

【解决方案1】：

不幸的是，您的逻辑有缺陷。您不能简单地从一个网页中获取该机制并假设它适用于下一个网页。在这种情况下，您尝试的解决方案将不起作用。当您在搜索中输入 SKU 时，实际发生的是页面重定向 (302)。不是您尝试过的网址构建。您看到的错误主要是由于点击了未找到的页面 - 尽管由于在 404 页面上未找到您的元素而出现。

相反，您可以使用相关页面实际用于初始 url 的构造，然后您可以使用 xmlhttp，它将遵循重定向如下：

VBA：

Option Explicit
Public Sub GetPrices()
    Dim xhr As XMLHTTP60, html As HTMLDocument, ws As Worksheet, i As Long

    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set xhr = New XMLHTTP60
    Set html = New HTMLDocument

    Dim allData()
    allData = ws.UsedRange.Value

    With xhr
        For i = 2 To UBound(allData, 1)
            .Open "GET", "https://www.neobits.com/search?keywords=" & allData(i, 2), False
            .send
            Dim price As Object
            html.body.innerHTML = .responseText
            Set price = html.querySelector("#main_price")
            If Not price Is Nothing Then
                allData(i, 3) = price.innerText
            Else
                allData(i, 3) = "No price found"
            End If
            Set price = Nothing
        Next
    End With
    ws.Cells(1, 1).Resize(UBound(allData, 1), UBound(allData, 2)) = allData
End Sub

我假设您在 Sheet1 中的页面设置如下：

所需的项目参考：

需要用红色限定的两个引用。按 Alt+F11 打开 VBE，然后转到 Tools > References 并添加引用。您可能有不同的 xml 库版本号 - 在这种情况下，引用将需要更改，因为

的代码引用也需要更改

Dim xhr As XMLHTTP60

和

New XMLHTTP60

要运行此代码：

按 Alt+F11 打开 VBE > 右键单击项目资源管理器 > 添加标准模块。将代码粘贴到该标准模块中 > 选择代码内的任意位置并按 F5，或点击功能区中的绿色 Run 箭头。

您可以进一步开发，例如，处理非 200 状态代码：

Option Explicit
Public Sub GetPrices()
    Dim xhr As XMLHTTP60, html As HTMLDocument, ws As Worksheet, i As Long

    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set xhr = New XMLHTTP60
    Set html = New HTMLDocument

    Dim allData(), price As Object
    allData = ws.UsedRange.Value

    With xhr
        For i = 2 To UBound(allData, 1)
            .Open "GET", "https://www.neobits.com/search?keywords=" & allData(i, 2), False
            .send
                If .Status <> 200 Then
                    allData(i, 3) = "Status not succeeded" '<== Little bit loose but you get the idea.
                Else
                    html.body.innerHTML = .responseText
                    Set price = html.querySelector("#main_price")
                    If Not price Is Nothing Then
                        allData(i, 3) = price.innerText
                    Else
                        allData(i, 3) = "No price found"
                    End If
                Set price = Nothing
            End If
        Next
    End With
    ws.Cells(1, 1).Resize(UBound(allData, 1), UBound(allData, 2)) = allData
End Sub

【讨论】：

哇！非常感谢您的有力回答。我是这个社区的新手，这是我的第一个问题，我可以看到这是一个很棒的社区，可以提问和学习。我将把这些知识带到任何未来的项目中。感谢您成为如此出色的老师，非常感谢。

【解决方案2】：

' Find the Range that has "Entity Type:"
Set entityRange = Sheet2.UsedRange.Find("Lists At:")

' Then return the value of the cell to its' right
URL_Get_SKU_Query1 = entityRange.Offset(0, 1).Value2

问题是Range.Find 可能由于各种原因找不到您要查找的内容。 Always specify the optional parameters to that function，因为否则它会“方便地记住”上次调用时的值 - 无论是来自其他 VBA 代码，还是通过 Excel UI（IOW 无法 100% 确定它将运行哪些值如果你不指定它们）。但即便如此，如果 Range.Find 没有找到它正在寻找的东西，它会返回 Nothing - 你不能只是假设这永远不会发生！

但是，仔细阅读...

' Find the Range that has "Entity Type:"
Set entityRange = Sheet2.UsedRange.Find("Lists At:")

有人在撒谎。阅读评论。现在阅读代码。谁在说真话？不要编写说“什么”的 cmets - 让 cmets 说“为什么”，让代码说“什么”。否则，您会遇到类似的情况，即无法判断注释是否过时或代码是否正确，至少不查看工作表就无法判断。

在任何情况下，您都需要确保entityRange 不是Nothing，然后再尝试针对它进行成员调用：

If Not entityRange Is Nothing Then
    URL_Get_SKU_Query1 = entityRange.Offset(0, 1).Value2
End If

【讨论】：