Excel 使用vba进行网页抓取，而无需在给定范围内重新运行每个输入

我正在解决以下问题：当链接插入a列时，我想刮去网站的标题，并将此值放入B列的相关单元格（旁边）。问题似乎是，一旦我将网站粘贴到a列，代码将重新运行整个列表，从A2列到代码中定义的“最后一行”。有没有办法只修改一个a列后再修改B列？也就是说，如果我在A36栏中粘贴一个链接，我就在B36中得到一个标题，不管该单元格是在使用范围的中间还是在最底部（即只有那些单元格受到影响）。（即循环“从i=2到最后一行”）？此外，我还想将以下内容从模块化宏（即sub）更改为私有sub，以响应更改（即intersect函数），其中“目标”是A:A范围内的任何单元格。非常感谢

在此处输入代码

Sub get_title_header()

Dim wb As Object
Dim doc As Object
Dim sURL As String
Dim lastrow As Long
lastrow = Sheet1.Cells(Rows.Count, "A").End(xlUp).row

For i = 2 To lastrow
Set wb = CreateObject("internetExplorer.Application")
sURL = Cells(i, 1)

wb.navigate sURL
wb.Visible = False

While wb.Busy
DoEvents
Wend

''HTML document
Set doc = wb.document

Cells(i, 2) = doc.Title

On Error GoTo err_clear
Cells(i, 3) = doc.GetElementsByTagName("h1")(0).innerText
err_clear:
If Err <> 0 Then
Err.Clear
Resume Next
End If
wb.Quit
Range(Cells(i, 1), Cells(i, 3)).Columns.AutoFit
Next i

End Sub

Sub get_title_header（）
作为对象的Dim wb
Dim doc作为对象
作为字符串的Dim sURL
最后一排一样长
lastrow=Sheet1.单元格（Rows.Count，“A”）.结束（xlUp）.行
对于i=2到最后一行
Set wb=CreateObject（“internetExplorer.Application”）
sURL=单元（i，1）
wb.sURL
wb.Visible=False
当wb忙的时候
多芬特
温德
''HTML文档
Set doc=wb.document
单元（i，2）=文件标题
错误时转到错误清除
单元格（i，3）=doc.GetElementsByTagName（“h1”）（0）
错误清除：
如果错误为0，则
呃，明白了
下一步继续
如果结束
wb.退出
范围（单元格（i，1），单元格（i，3））.Columns.AutoFit
接下来我
端接头

将代码放入工作表更改事件（右键单击工作表选项卡>>查看代码>>粘贴代码）

Private子工作表\u更改（ByVal目标作为范围）
Dim ie作为对象，doc作为对象，sURL作为字符串
如果Target.Cells.CountLarge>1，则退出Sub
如果Target.Column=1，则
设置ie=CreateObject（“internetExplorer.Application”）
sURL=目标值
与ie
.导航sURL
.Visible=False
忙的时候
设置文档=.doc
以
Target.Offset（，1）.Value=单据标题
错误时转到错误清除
Target.Offset（，2）.Value=doc.getElementsByTagName（“h1”）（0）.innerText
错误明确：
如果错误为0，则清除错误：继续下一步
即退出
设置ie=无
应用程序。立即等待+时间值（“00:00:03”）
列（“A:C”）。自动拟合
如果结束
端接头

将代码放入工作表更改事件（右键单击工作表选项卡>>查看代码>>粘贴代码）

Private子工作表\u更改（ByVal目标作为范围）
Dim ie作为对象，doc作为对象，sURL作为字符串
如果Target.Cells.CountLarge>1，则退出Sub
如果Target.Column=1，则
设置ie=CreateObject（“internetExplorer.Application”）
sURL=目标值
与ie
.导航sURL
.Visible=False
忙的时候
设置文档=.doc
以
Target.Offset（，1）.Value=单据标题
错误时转到错误清除
Target.Offset（，2）.Value=doc.getElementsByTagName（“h1”）（0）.innerText
错误明确：
如果错误为0，则清除错误：继续下一步
即退出
设置ie=无
应用程序。立即等待+时间值（“00:00:03”）
列（“A:C”）。自动拟合
如果结束
端接头

不幸的是，它似乎不起作用。一旦我在a列的任何单元格中插入值，什么都不会发生：（代码在工作表模块中，而不是在标准模块中。尝试在第一行放置断点，然后进行更改并按照代码行查看问题。不幸的是，它似乎不起作用。一旦我在a列的任何单元格中插入值，什么都不会发生：（代码在工作表模块中，而不是标准模块中。请尝试在第一行添加断点，然后进行更改，并按照代码行查看问题。）。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ie As Object, doc As Object, sURL As String
If Target.Cells.CountLarge > 1 Then Exit Sub
If Target.Column = 1 Then
    Set ie = CreateObject("internetExplorer.Application")
    sURL = Target.Value

    With ie
        .navigate sURL
        .Visible = False
        While .Busy: DoEvents: Wend
        Set doc = .document
    End With

    Target.Offset(, 1).Value = doc.Title
    On Error GoTo errClear
    Target.Offset(, 2).Value = doc.getElementsByTagName("h1")(0).innerText

errClear:
    If Err <> 0 Then Err.Clear: Resume Next
    ie.Quit
    Set ie = Nothing
    Application.Wait Now + TimeValue("00:00:03")
    Columns("A:C").AutoFit
End If
End Sub