Question

如何在EXCEL中使用VBA执行库存回溯测试。

非常感谢你的回答。

Answer 1

您可以使用InternetExplorer.Application对象库来连接互联网，请在VBA上启用库 - ＆gt;工具 - ＆gt;参考，选择＆amp; tick＆＃34; Microsoft Internt Controls＆＃34;。在Excel工作表1上创建圆形，单击清晰并选择＆＃34;指定宏＆＃34;这将添加以下宏代码，您可以在单击锐利后运行自动代码，或者您可以使用＆＃34; F5＆＃34;密钥运行代码，并把你想要的所有股票编号，＆amp;放置＆amp;在A6，A7，A8等处启动它。当A列单元格没有库存号或空时，宏将完成循环。请测试以下代码

VBA代码

<code>
            Global myIE As SHDocVw.InternetExplorer
            Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
            Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
            Sub Extract()
            Set myIE = Nothing
            Set myIE = CreateObject("InternetExplorer.Application")
            'Set myIE = New InternetExplorer
            Dim a As String
            Dim b As String
            Dim g As Integer
            Dim workbookname As String
            Dim n As Integer
            Dim c As Integer
            Dim str As Variant
            Application.ScreenUpdating = True
            Application.DisplayAlerts = False
            a = 4
            With myIE
             .Top = 10
            .Left = 1900
            .Height = 800
            .Width = 600
            .Visible = False
             Dim stockno As String
             Worksheets("Sheet1").Activate
            .navigate "http://www.etnet.com.hk/www/eng/stocks/realtime/quote.php"
            Call WAITING(myIE, 10)
            Worksheets("Sheet1").Select
            Worksheets("Sheet1").Range("B6").Select
             Worksheets("Sheet1").Range("B6:Z1000").ClearContents
             Sleep (200)
            Do Until Worksheets("Sheet1").Cells(a + 2, 1) = ""
            stockno = Worksheets("Sheet1").Cells(a + 2, 1)
            If stockno > 0 And stockno < 10 Then stockno = "0000" & stockno
            If stockno > 9 And stockno < 100 Then stockno = "000" & stockno
            If stockno > 99 And stockno < 1000 Then stockno = "00" & stockno
            If stockno > 999 And stockno < 10000 Then stockno = "0" & stockno
            b = 0
            Do Until b = 1
            On Error Resume Next
            .Document.all("quotesearch").Value = Worksheets("Sheet1").Cells(a + 2, 1)
            .Document.all("quotesearch_submit").Click
            b = InStr(myIE.Document.getElementById("StkQuoteHeader").innerText, stockno)
            Debug.Print b & "  " & stockno
            Sleep (1000)
            Loop
            n = .Document.getElementById("StkDetailMainBox").getElementsByTagName("span").Length
            Debug.Print n
            g = 0
            c = 0
            Do Until g > n - 1
             str = .Document.getElementById("StkDetailMainBox").getElementsByTagName("span").Item(g).innerHTML
            str = Replace(str, "&nbsp;", "")
            On Error GoTo Skip
            If Not Mid(str, 1, 1) = "" And Not Mid(str, 1, 1) = "B" And Not Mid(str, 1, 1) = "<" Then
            Worksheets("Sheet1").Cells(a + 2, c + 2) = str
            c = c + 1
            End If
            Skip:
            g = g + 1
            Loop
            a = a + 1
            Loop
            leave:
            myIE.Quit
            End With
            End Sub
            Function WAITING(ByRef myIE As SHDocVw.InternetExplorer, ByRef state As Integer)
            Dim b As Variant
            With myIE
            b = Time()
            On Error GoTo L1
            Do Until Not .Busy And .readyState = READYSTATE_COMPLETE Or TimeValue(Time()) - TimeValue(b) > TimeValue("00:00:15")
            Loop
                 If Not .Busy And .readyState = READYSTATE_COMPLETE Then
                 DoEvents
                 state = 0
                 Else
                 state = 1
                 End If
               End With
            L1:
            End Function

</code>

如何在EXCEL中使用VBA执行库存回测

1 个答案: