VBA循环遍历行并返回值

Question

真的很感激这方面的一些帮助。我有一个抓取数据的 vba 脚本，它打开包含在 L 列中的 URL，在本例中为 L4。然后稍后在脚本中将我给定的值输入到 Col E，第 4 行。

Sub ImportData()
...
With CreateObject("msxml2.xmlhttp")
.Open "GET", Range("L4"), False 'Cell that contains hyperlink
.send
HTML_Content.body.innerHTML = .responseText
End With
...

'Then I want to return a value
Sheets(1).Range("E4").Value = rng1.Offset(0, 1)
End Sub

我正在尝试创建一个循环，以便脚本自动运行并循环遍历 L 列，并为在 Col L 中包含超链接的每一行运行脚本，然后将值输入到 Col E 中的相应行。

我已尝试更改其他用户建议的以下代码但没有成功：

Sub ImportData(urlToOpen as string)
...
.Open "GET", urlToOpen, False 'Cell that contains hyperlink
...
'Then I want to return a value
Sheets(1).Range(E, i).Value = rng1.Offset(0, 1) ' I know that's wrong

并添加一个调用过程：

Sub CallRangeL_Urls()
For Each i In Sheet1.Range("L4:L200")
    Call ImportData(i)
Next i
End Sub

我在 Call ImportData(i) 上不断收到 ByRef 类型参数不匹配错误

我也不确定如何将值调用到循环中正在处理的特定行。任何帮助将不胜感激。谢谢

Answer 1

尝试以下方法：

Public Sub ImportData(ByVal urlToOpen As String)

和

Public Sub CallRangeL_Urls()
    Dim i As Range
    For Each i In Sheet1.Range("L4:L200")
        ImportData i.Value
    Next i
End Sub

就个人而言，我也会参考工作簿，我通常使用Worksheets("SheetName")，但我知道很多人喜欢使用 codeName。

您只想传递单元格中链接的值，因此ByVal 是合适的方式。

由于触摸工作表很昂贵，我可能会将 url 转储到一个数组中并循环它，添加一个我正在使用 url 的基本测试：

Public Sub CallRangeL_Urls()
    Dim arr(), i As Long
    arr = Application.Transpose(Sheet1.Range("L4:L200").Value)
    For i = LBound(arr) To UBound(arr)
        If InStr(arr(i), "http") > 0 Then ImportData arr(i)
    Next i
End Sub

---

要将提取的值写入 E 列，与 url 相同的行，我认为您需要将 ImportData 子转换为返回提取值的函数。或者更好的是，创建一个类来保存 xmlhttp 对象，然后该对象有一个返回值的方法（这样你就不会继续创建和销毁对象 - 如果你在函数中创建对象，你会这样做。你也可以在第一个 sub 中创建 xmlhttp 对象并作为参数传递给函数 - 我将在下面向您展示伪代码。

Public Sub CallRangeL_Urls()
    Dim arr(), i As Long
    'code to create xmlhttp object
    arr = Application.Transpose(Sheet1.Range("L4:L200").Value)
    For i = LBound(arr) To UBound(arr)
        If InStr(arr(i), "http") > 0 Then
            Sheet1.Cells(i + 3, "E") = ImportData(arr(i), xmlhttpObject)
        End If
    Next i
End Sub

Public Function ImportData(ByVal urlToOpen As String, ByVal xmlhttpObject As Object) As String
    ''Any declarations
    'Dim extractedValue As String
    'Dim html As HTMLDocument
    'Set html = New HTMLDocument
    With xmlhttpObject
        .Open "GET", urlToOpen, False
        .send
        html.body.innerHTML = .responseText
        ''code to extract value
        'extractedValue = html.querySelector("someSelector")
    ImportData = extractedValue
End Function