데이터를 온라인으로 긁어 내 노트북 ​​성능이 저하되는 VBA 프로그램

Question

웹 사이트에서 데이터를 스크래핑하기위한 VBA Excel 프로그램을 만든 적이 처음입니다. 먼저, 단일 값을 긁어내어 cells(1,1)에 인쇄하는 간단한 프로그램을 사용해 보았습니다. 여러 번 실패하고 내 바이러스 백신에서 많은 경고를 받았지만 마침내 성공했습니다. 그런 다음 프로그램을 복잡한 프로그램으로 수정하고 오류가 발생했는지 여부를 확인하기 위해 프로그램을 매번 수정합니다. 내가 깨달은 한가지는 수정 후 프로그램을 실행할 때마다 내 랩톱이 매우 느리게 실행되고 프로세서 팬이 너무 빠르게 실행되어 매우 크게 실행된다는 것입니다. 그러나 내 프로그램은 여전히 ​​효과가있었습니다.

Sub Download_Data() 
Dim IE As Object, Data_FOREX As String 
T0 = Timer 
Application.ScreenUpdating = False 
Range("A:J").Clear 

Set IE = CreateObject("internetexplorer.application") 
With IE 
    .navigate "http://uk.investing.com/currencies/streaming-forex-rates-majors" 
    .Visible = False 
End With 
Do 
    DoEvents 
Loop Until IE.readyState = READYSTATE_COMPLETE 

For i = 1 To 13 
Set FOREX = IE.document.getElementById("pair_" & i) 
    For j = 1 To 9 
     Data_FOREX = FOREX.Cells(j).innerHTML 
     If j = 1 Then 
      Cells(i + 1, j + 1) = Mid(Data_FOREX, 11, 7) 
     Else 
      Cells(i + 1, j + 1) = Data_FOREX 
     End If 

     If Cells(i + 1, 8) < 0 Then 
      Cells(i + 1, 8).Font.Color = vbRed 
      Cells(i + 1, 9).Font.Color = vbRed 
     Else 
      Cells(i + 1, 8).Font.Color = vbGreen 
      Cells(i + 1, 9).Font.Color = vbGreen 
     End If 

     If j = 9 Then 
     Cells(i + 1, 10) = Mid(Data_FOREX, 4, 2) & "/" & Mid(Data_FOREX, 1, 2) 
     End If 
    Next j 
Next i 

IE.Quit 
Set IE = Nothing 

Cells(1, 2) = "Pair" 
Cells(1, 3) = "Bid" 
Cells(1, 4) = "Ask" 
Cells(1, 5) = "Open" 
Cells(1, 6) = "High" 
Cells(1, 7) = "Low" 
Cells(1, 8) = "Change" 
Cells(1, 9) = "% Change" 
Cells(1, 10) = "Date" 
Range("A1:J").Font.Bold = True 
Range("A1:J1").HorizontalAlignment = xlCenter 
Range("C:H").NumberFormat = "0.0000" 
Columns("A:J").AutoFit 
MsgBox "Downloading data is complete." _ 
     & vbNewLine & "The running time is " & Round(Timer - T0, 2) & " s." 
End Sub 

내가 전에 타이머 기능을 사용하지 않은,하지만 난 그게 더 느린 속도가 느린 모든 수정을 받고 있기 때문에 프로그램이 실행 시간을 알고 그것을 사용하기로 결정 : 여기 내 전체 코드입니다. 위의 프로그램을 실행할 때 매우 오랜 시간이 걸렸으므로 중단했습니다. 타이머 기능을 삭제해도 여전히 오래 실행됩니다. 나는 그것을 다시 멈추었지만 이번에는 Sheet1에 출력이 없었다. 그 후에도 내 노트북은 매우 느리게 작동하고 두 번 종료합니다 (매우 열심히 시도하고 사용하지 않음). 나는 프로그램을 단순화하려고 노력했지만 이상하게도 이전에는 효과가 있었지만 작동하지 않았다. 문제는 여기에서 비가 내리기 때문에 인터넷 연결이라고 생각했습니다. 내 인터넷 연결을 확인하려고 Speed Test을 시도했지만 괜찮 았어. 5 번 테스트 해 보겠습니다.

Ping (ms) Download Speed (Mbps) Upload Speed (Mbps) 
10   3.64     0.62 
10   3.24     0.34 
11   2.94     0.53 
11   3.33     0.58 
10   4.84     0.49 

문제가있는 곳은 어디입니까? 고칠 수 있습니까? 또한 화살표를 위/아래 화살표 Forex Rate에 A 열의 셀에 삽입하는 방법을 알고 싶습니까? Dim Arrow As Icon: Arrow = FOREX.Cells(0).innerHTML을 시도했지만 작동하지 않았습니다.

Answer 1

이 답변은 내 게시물에 Mr. Jeeped's answer의 영감을 받았습니다. Code that works once/ twice either by F5 or F8 but then gets multiple errors. 나는 그에게 에 대해 VBA Excel 학습에 대한 단계별 가이드에 대해 감사 드리고 싶습니다. 그의 관대함이 정말로 나를 도왔다.

워크 시트 코드 모듈 (Sheet1)에 넣습니다. 도구 ► 참조에 Microsoft HTML Object Library 및 Microsoft XML, v6.0이 필요합니다. 프로그램의 출력은 형식 번호가 포함 된 Investing.com에 표시된 것과 거의 동일한 디스플레이입니다 (관련 주제는 How to make Excel doesn't truncate 0's in formatting decimal numbers? 참조). 당신이 객체로 IE 문서를로드 그냥 객체에 대한 처리를 실행하는 경우

Sub Download_Data() 
    Dim FOREX As New HTMLDocument, xmlHTTP As New MSXML2.XMLHTTP60 
    Dim Website_URL As String, Data_FOREX As String, Range_Data As Range 
    Dim i As Long, j As Long, Dec_Number As Long, Last_Row As Long 

    Application.ScreenUpdating = False 
    Range("A:J").Clear 
    Website_URL = "http://uk.investing.com/currencies/streaming-forex-rates-majors" 

    With xmlHTTP 
     .Open "GET", Website_URL, False 
     .setRequestHeader "User-Agent", "XMLHTTP/1.0" 
     .send 
     If .Status <> 200 Then GoTo Safe_Exit 
     FOREX.body.innerHTML = .responseText 
    End With 

For i = 1 To 20 
    For j = 1 To 9 
    With FOREX 
     If Not .getElementById("pair_" & i) Is Nothing Then 
      With .getElementById("pair_" & i) 
       Data_FOREX = CStr(.Cells(j).innerText) 
       Cells(i + 1, j + 1).Value = Data_FOREX 

       'Formatting the numbers, i.e. quote prices 
       If j > 1 And j < 7 Then 
        Dec_Number = Len(Data_FOREX) - InStr(Data_FOREX, ".") 
        Cells(i + 1, j + 1) = Val(Data_FOREX) 

        If Dec_Number = Len(Data_FOREX) Then 
         Cells(i + 1, j + 1).NumberFormat = "0" 
        Else 
         Cells(i + 1, j + 1).NumberFormat = "0." _ 
         & WorksheetFunction.Rept("0", Dec_Number) 
        End If 
       End If 
      End With 
     Else 
      Exit For 
     End If 
    End With 
    Next j 

    'Copy number format in column G and paste it in column H 
    Cells(i + 1, "G").Copy 
    Cells(i + 1, "H").PasteSpecial Paste:=xlPasteFormats 

    'Coloring specific data   
    If Cells(i + 1, "H") < 0 Then 
     Cells(i + 1, "H").Font.Color = vbRed 
     Cells(i + 1, "I").Font.Color = vbRed 
    Else 
     Cells(i + 1, "H").Font.Color = RGB(0, 150, 0) 
     Cells(i + 1, "I").Font.Color = RGB(0, 150, 0) 
    End If 
    Cells(i + 1, "B").Font.Bold = True 
    Cells(i + 1, "B").Font.Color = RGB(18, 86, 168) 
    Range(Cells(i + 1, "H"), Cells(i + 1, "I")).Font.Bold = True 
Next i 

'Deleting the cells with empty entries, i.e. pair_i doesn't exist 
Last_Row = Cells(Rows.Count, "B").End(xlUp).Row 
Set Range_Data = Range("A2:J" & Last_Row).SpecialCells(xlCellTypeBlanks) 
Range_Data.Rows.Delete Shift:=xlShiftUp 

'Format table header 
Cells(1, 2) = "Pair" 
Cells(1, 3) = "Bid" 
Cells(1, 4) = "Ask" 
Cells(1, 5) = "Open" 
Cells(1, 6) = "High" 
Cells(1, 7) = "Low" 
Cells(1, 8) = "Change" 
Cells(1, 9) = "% Change" 
Cells(1, 10) = "Time" 
Range("A1:J1").Font.Bold = True 
Range("A1:J1").HorizontalAlignment = xlCenter 
Range("A:J").VerticalAlignment = xlCenter 
Columns("A:J").ColumnWidth = 10 

Safe_Exit: 
    Set FOREX = Nothing: Set xmlHTTP = Nothing 
End Sub