VBA如果使用的范围包含单词/文本/值，请返回到上一步

Question

我写了一个从网站下载数据的宏，在网站完全加载后，它会通过html标签废弃数据，但是，有时由于未知错误而错误地抓取数据，我想在每个变量'x'完成后添加一个检查，例如，如果活动表中包含"《金融时报》"一词，那么回到"选择报告类型"步骤重新进行抓取。此外，我知道一些变量/数据类型在一开始就没有设置。有人能帮忙解决这个问题吗?提前感谢!

Sub GetFinanceData()
    Dim x As Variant
    Dim IE As Object
    For x = 1 To 1584
    Dim URL As String, elemCollection As Object
    Dim t As Integer, r As Integer, c As Integer
    Worksheets("Stocks").Select
    Worksheets("Stocks").Activate
    'Open IE and Go to the Website
    'URL = "http://stock.finance.sina.com.cn/hkstock/finance/00001.html"
    URL = Cells(x, 1)
    Set IE = CreateObject("InternetExplorer.Application")
    With IE
        .navigate URL
        .Visible = False
        Do While .Busy = True Or .readyState <> 4
            Loop
        DoEvents
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = _
    ThisWorkbook.Worksheets("Stocks").Range("B" & x).Value     'You could even simplify it and just state the name as Cells(x,2)

    'Select the Report Type
    Set selectItems = IE.Document.getElementsByTagName("select")
        For Each i In selectItems
            i.Value = "zero"
            i.FireEvent ("onchange")
            Application.Wait (Now + TimeValue("0:00:05"))
        Next i
        Do While .Busy: DoEvents: Loop
    ActiveSheet.Range("A1:K2000").ClearContents
    ActiveSheet.Range("A1").Value = .Document.getElementsByTagName("h1")(0).innerText
    ActiveSheet.Range("B1").Value = .Document.getElementsByTagName("em")(0).innerText
    ActiveSheet.Range("A4").Value = Worksheets("Stocks").Cells(1, 4)
    'Find and Get Table Data
    tblNameArr = Array(Worksheets("Stocks").Cells(2, 4), Worksheets("Stocks").Cells(3, 4), Worksheets("Stocks").Cells(4, 4), Worksheets("Stocks").Cells(5, 4))
    tblStartRow = 6
    Set elemCollection = .Document.getElementsByTagName("TABLE")
    For t = 0 To elemCollection.Length - 1
        For r = 0 To (elemCollection(t).Rows.Length - 1)
            For c = 0 To (elemCollection(t).Rows(r).Cells.Length - 1)
                ActiveSheet.Cells(r + tblStartRow, c + 1) = elemCollection(t).Rows(r).Cells(c).innerText
            Next c
        Next r
        ActiveSheet.Cells(r + tblStartRow + 2, 1) = tblNameArr(t)
        tblStartRow = tblStartRow + r + 4
    Next t
        End With
        ' cleaning up memory
        IE.Quit
    Next x
End Sub

Answer 1

这是相当清理。

我添加了一个SelectReportType: line标签。当您想要返回到那个条件时，使用插入

行

Goto SelectReportType

它会带你到那个地方。更好的方法是将该代码放在一个单独的函数中，这样您就可以在任何时候对"金融时报"的测试为真时调用它。但是我没有很好地遵循你的代码，无法理解你在做什么来帮助你。

Sub GetFinanceData()
    Dim x As Variant
    Dim IE As Object
    Dim URL As String, elemCollection As Object
    Dim t As Integer, r As Integer, c As Integer
    Dim selectItems As Variant, i As Variant
    Dim tblNameArr() As String
    Dim tblStartRow As Long
    Worksheets("Stocks").Select
    Worksheets("Stocks").Activate
    For x = 1 To 1584
        'Open IE and Go to the Website
        'URL = "http://stock.finance.sina.com.cn/hkstock/finance/00001.html"
        URL = Cells(x, 1)
        Set IE = CreateObject("InternetExplorer.Application")
        With IE
            .Navigate URL
            .Visible = False
            Do While .Busy = True Or .ReadyState <> 4
                Loop
            DoEvents
            Worksheets.Add(After:=Worksheets(Worksheets.count)).name = _
            ThisWorkbook.Worksheets("Stocks").Range("B" & x).Value     'You could even simplify it and just state the name as Cells(x,2)
SelectReportType:
            'Select the Report Type
            Set selectItems = IE.Document.getElementsByTagName("select")
                For Each i In selectItems
                    i.Value = "zero"
                    i.FireEvent ("onchange")
                    Application.Wait (Now + TimeValue("0:00:05"))
                Next i
                Do While .Busy: DoEvents: Loop
                ActiveSheet.Range("A1:K2000").ClearContents
                ActiveSheet.Range("A1").Value = .Document.getElementsByTagName("h1")(0).innerText
                ActiveSheet.Range("B1").Value = .Document.getElementsByTagName("em")(0).innerText
                ActiveSheet.Range("A4").Value = Worksheets("Stocks").Cells(1, 4)
                'Find and Get Table Data
                tblNameArr = Array(Worksheets("Stocks").Cells(2, 4), Worksheets("Stocks").Cells(3, 4), Worksheets("Stocks").Cells(4, 4), Worksheets("Stocks").Cells(5, 4))
                tblStartRow = 6
                Set elemCollection = .Document.getElementsByTagName("TABLE")
                For t = 0 To elemCollection.Length - 1
                    For r = 0 To (elemCollection(t).Rows.Length - 1)
                        For c = 0 To (elemCollection(t).Rows(r).Cells.Length - 1)
                            ActiveSheet.Cells(r + tblStartRow, c + 1) = elemCollection(t).Rows(r).Cells(c).innerText
                        Next c
                    Next r
                    ActiveSheet.Cells(r + tblStartRow + 2, 1) = tblNameArr(t)
                    tblStartRow = tblStartRow + r + 4
                Next t
        End With
        ' cleaning up memory
        IE.Quit
    Next x
End Sub