1

Web サイトからデータをダウンロードするマクロを作成しました。Web サイトが完全に読み込まれた後、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
4

1 に答える 1

0

これでだいぶすっきりしました。

SelectReportType: 行ラベルを追加しました。その状態に戻りたいときはいつでも、次の行を挿入してください

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
于 2015-09-02T13:04:08.083 に答える