Как использовать VBA в EXCEL для проведения бэк-теста

Question

Как использовать VBA в EXCEL для проверки запасов на складе.

Большое спасибо за ваш ответ.

Answer 1

Вы можете использовать библиотеку объектов InternetExplorer.Application для подключения к Интернету. Пожалуйста, включите библиотеку в VBA -> Инструменты-> Справочник, выберите и отметьте «Microsoft Internt Controls».Создав круглую форму на листе Excel 1, щелкните острый и выберите «назначить макрос», который добавит следующий код макроса, и вы можете запустить код автоматически после нажатия на острый ИЛИ вы можете использовать клавишу «F5» для запуска кода,и поместите все нужные вам номера акций, а также установите и начните его с 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>