使用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

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

请参考以下内容。

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

使用Array with Named Range加速VBA