Question

我正在尝试编写一个脚本来从vitals.com获取医生评论并将它们放入Excel表格中。当我刚刚提交评论时，它运作良好，但是当我添加它以提取日期时，它将打印第一个评论和日期，然后加载一段时间，然后崩溃。我是所有这一切的新手，所以我希望有一些我没有看到的明显错误。我似乎无法找到解决方法。任何帮助将不胜感激。

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim DocCounter As Integer
  DocCounter = 2
  Dim Go As String
  Go = "Go"

  If IsEmpty(Cells(1, 4)) And Cells(1, 3).Value = Go Then

    If IsEmpty(Cells(DocCounter, 1).Value) Then GoTo EmptySheet
    Do

      Dim Reviews As String
      Reviews = "/reviews"

      Dim IE As MSXML2.XMLHTTP60
      Set IE = New MSXML2.XMLHTTP60

      Application.Wait (Now + TimeValue("0:00:01"))
      IE.Open "get", "http://vitals.com/doctors/" & Cells(DocCounter, 1).Value & Reviews, True
      IE.send

      While IE.readyState <> 4
        DoEvents
      Wend

      Application.Wait (Now + TimeValue("0:00:01"))

      Dim HTMLDoc As MSHTML.HTMLDocument
      Dim HTMLBody As MSHTML.HTMLBody
      Set HTMLDoc = New MSHTML.HTMLDocument
      Set HTMLBody = HTMLDoc.body
      HTMLBody.innerHTML = IE.responseText

      Dim ReviewCounterString As String
      Dim ReviewCounter As Integer
      ReviewCounterString = HTMLDoc.getElementsByName("overall_total_reviews")(0).getElementsByTagName("h3")(0).innerText
      ReviewCounter = CInt(ReviewCounterString)

      'Pull info from website loop'
      Dim RC As Integer
      RC = 2

      Dim sDD As String
      Dim WebCounter As Integer
      WebCounter = 0

        Do
          sDD = HTMLDoc.getElementsByClassName("date c_date dtreviewed")(WebCounter).innerText & "-" & HTMLDoc.getElementsByClassName("description")(WebCounter).innerText
          Cells(DocCounter, RC).Value = sDD
          WebCounter = WebCounter + 1
          RC = RC + 1
          Application.Wait (Now + TimeValue("0:00:01"))
        Loop Until WebCounter = ReviewCounter

      Application.Wait (Now + TimeValue("0:00:01"))
      DocCounter = DocCounter + 1
      If IsEmpty(Cells(DocCounter, 1).Value) Then GoTo Finished

    Loop

Finished:
    MsgBox ("Complete")
    End Sub

EmptySheet:
    MsgBox ("The Excel Sheet is Empty. Please add Doctors.")
    End Sub

  End If
End Sub

Answer 1

当你执行Cells(DocCounter, RC).Value = sDD Worksheet.Change事件再次被触发并且宏重新开始时，直到调用堆栈已满（我认为）。

添加

 Application.EnableEvents = False

在宏的开头和

Application.EnableEvents = True

最后。这样，在宏期间不会触发事件。

编辑：你应该考虑每次在工作表上的任何地方发生任何变化时是否真的有必要运行宏。您可以先检查Target（已更改的范围），以查看更改是否需要重新加载数据。

VBA问题从Web中提取信息并将其置于Excel中

1 个答案: