使用 VBA 解析 CSV 文件并将数据写入工作表很慢

Question

以下代码从网站下载两个 CSV 文件，解析 CSV 文件，并写入工作簿的三个工作表。

其中一个文件有大约 2000 条记录，另一个有大约 300 条记录。

如果我下载这些 CSV 文件并使用 MS Excel 打开，这些文件会立即打开。但是我的代码运行得很慢。

Private Sub Workbook_Open()
    On Error GoTo ErrHandler
    Application.ScreenUpdating = True
    
    'initial request just to grab the cookie
    
    Dim objHttpRequest As Object
    Set objHttpRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
    
    objHttpRequest.Open "GET", "https://www.nseindia.com/reports/asm", False
    objHttpRequest.SetRequestHeader "REFERER", "https://www.nseindia.com/reports/asm"
    objHttpRequest.SetRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)"
    
    objHttpRequest.Send
    
    'store the cookie for using with consecutive requests
    Dim strNSECookie As String
    strNSECookie = objHttpRequest.GetResponseHeader("Set-Cookie")
    
'Downloading NSE ASM List (CSV file) ------------------------------------------------------------------------------------
        
    'downloading the nse asm list (csv file)
    objHttpRequest.Open "GET", "https://www.nseindia.com/api/reportASM?csv=true", False
    objHttpRequest.SetRequestHeader "REFERER", "https://www.nseindia.com/reports/asm"
    objHttpRequest.SetRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)"
    objHttpRequest.SetRequestHeader "cookie", strNSECookie
    
    objHttpRequest.Send
    
    'parsing the csv data using split function and writing it on a woorksheet
    Dim arrNSEASMRecords As Variant
    Dim arrNSEASMRecordValues As Variant
    Dim intNSEASMRecordsCounter As Integer
    Dim intNSEASMSerialNumberCounter As Integer
    Dim strWorkSheetName As String
    Dim intNSEASMTotalRecords As Integer
    
    arrNSEASMRecords = Split(objHttpRequest.ResponseText, vbLf)
    intNSEASMTotalRecords = UBound(arrNSEASMRecords) - 1
    
    For intNSEASMRecordsCounter = 0 To intNSEASMTotalRecords Step 1
        arrNSEASMRecordValues = Split(arrNSEASMRecords(intNSEASMRecordsCounter), ",")
        
        If arrNSEASMRecordValues(0) = """Long Term""" Then
            strWorkSheetName = "LT"
            Worksheets(strWorkSheetName).UsedRange.ClearContents
            intNSEASMSerialNumberCounter = 1
        ElseIf arrNSEASMRecordValues(0) = """Short Term""" Then
            strWorkSheetName = "ST"
            Worksheets(strWorkSheetName).UsedRange.ClearContents
            intNSEASMSerialNumberCounter = 1
        ElseIf IsNumeric(arrNSEASMRecordValues(0)) Then
            Worksheets(strWorkSheetName).Range("A" & intNSEASMSerialNumberCounter).Value = Replace(arrNSEASMRecordValues(0), """", "")
            Worksheets(strWorkSheetName).Range("B" & intNSEASMSerialNumberCounter).Value = Replace(arrNSEASMRecordValues(1), """", "")
            Worksheets(strWorkSheetName).Range("C" & intNSEASMSerialNumberCounter).Value = Replace(arrNSEASMRecordValues(2), """", "")
            Worksheets(strWorkSheetName).Range("D" & intNSEASMSerialNumberCounter).Value = Replace(arrNSEASMRecordValues(3), """", "")
            Worksheets(strWorkSheetName).Range("E" & intNSEASMSerialNumberCounter).Value = Replace(arrNSEASMRecordValues(4), """", "")
            
            intNSEASMSerialNumberCounter = intNSEASMSerialNumberCounter + 1
        End If
    Next intNSEASMRecordsCounter
    
'Downloading price band list (CSV file)--------------------------------------------------------------------------------------------
    
    Dim strNSEPBLatestFile As String
    Dim objDateCounter As Date
    
    objDateCounter = Now()
    
    'Loop to generate the latest file name and sending the request to the website
    'Mostly the latest file is of previous date but in case of holidays and weekends
    'the file maybe few more days older
    Do
        strNSEPBLatestFile = "sec_list_" & Format(objDateCounter, "ddmmyyyy") & ".csv"
        
        objHttpRequest.Open "GET", "https://archives.nseindia.com/content/equities/" & strNSEPBLatestFile, False
        objHttpRequest.SetRequestHeader "REFERER", "https://www.nseindia.com/reports/asm"
        objHttpRequest.SetRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)"
        objHttpRequest.SetRequestHeader "cookie", strNSECookie
        
        objHttpRequest.Send
        
        objDateCounter = DateAdd("d", -1, objDateCounter)
    Loop While objHttpRequest.Status <> 200
    
    'parsing the csv data using split function and writing it on a woorksheet
    Dim arrNSEPBRecords As Variant
    Dim arrNSEPBRecordValues As Variant
    Dim intNSEPBRecordsCounter As Integer
    Dim intNSEPBTotalRecords As Integer
    
    arrNSEPBRecords = Split(objHttpRequest.ResponseText, vbLf)
    strWorkSheetName = "Price Band"
    Worksheets(strWorkSheetName).UsedRange.ClearContents
    intNSEPBTotalRecords = UBound(arrNSEPBRecords) - 1
    
    Debug.Print "Price band Record : " & UBound(arrNSEPBRecords)
    
    For intNSEPBRecordsCounter = 0 To intNSEPBTotalRecords Step 1
        arrNSEPBRecordValues = Split(arrNSEPBRecords(intNSEPBRecordsCounter), ",")
        
        Worksheets(strWorkSheetName).Range("A" & intNSEPBRecordsCounter + 1).Value = Replace(arrNSEPBRecordValues(0), """", "")
        Worksheets(strWorkSheetName).Range("B" & intNSEPBRecordsCounter + 1).Value = Replace(arrNSEPBRecordValues(1), """", "")
        Worksheets(strWorkSheetName).Range("C" & intNSEPBRecordsCounter + 1).Value = Replace(arrNSEPBRecordValues(2), """", "")
        Worksheets(strWorkSheetName).Range("D" & intNSEPBRecordsCounter + 1).Value = Replace(arrNSEPBRecordValues(3), """", "")
        Worksheets(strWorkSheetName).Range("E" & intNSEPBRecordsCounter + 1).Value = Replace(arrNSEPBRecordValues(4), """", "")
        Application.StatusBar = "Written : " & intNSEPBRecordsCounter + 1 & " of " & intNSEPBTotalRecords
        
    Next intNSEPBRecordsCounter
    
    Exit Sub
    
ErrHandler:
    MsgBox "Error : " & Err.Description
End Sub

Answer 1

写入工作表是一项耗时的任务。 在您的代码中，写入工作表会发生多次（因为它逐个单元格地写入），因此速度很慢。 您应该首先将所有数据写入二维数组， 然后将数组一次复制到一个工作表范围内。

请参考以下内容。

https://morsagmon.com/blog/the-huge-performance-difference-worksheet-cells-vs-arrays/

Speed up VBA using Array with Named Range