Dictionary use(MS Scripting Library)和其他一些方法,用于改善Excel中超过100,000行数据的Excel文件的执行时间

考虑一下你有一堆资产的场景,并且你有与每种资产相关的数字。 我们正在将这些数字从A集更改为B集,所以我正在编写一个脚本,以便根据原始集A的数量为Excel中的新列填充集B的某些值。 每套有11万件。

由于信息分散在很多表格中,我采用了VBA方法。 我的原始代码通过string的简单比较执行:

Public Function SearchSAP(StkCd As Long) As Long Dim wb As Workbook Dim shSAP As Worksheet Dim i As Long ' SAP sheet name is fixed and does not change Set wb = ActiveWorkbook Set shSAP = wb.Worksheets("SAP") ' i is the start row of the SAP sheet for data i = 2 ' Define no-match value as -1 SearchSAP = -1 Do While i < shSAP.UsedRange.Rows.Count And i < 106212 If shSAP.Cells(i, 1).value = Stkcd Then SearchSAP = shSAP.Cells(i, 2).value Exit Do End If i = i + 1 Loop Set shSAP = Nothing Set wb = Nothing End Function 

这个function让我永远执行,可能更接近于i7 2.4 GHz内核的15-20分钟。 我几乎认为我已经编写了一个无限循环的错误。 当它最终给我“-1”时,我意识到它确实需要那么长时间。 研究了stackoverflow,我发现了“ 如何优化vlookup以获得高search次数?(替代VLOOKUP) ”这似乎表明字典是要走的路。 所以我试了一下:

 Public Function SearchSAP(StkCd As Long) As Long Dim wb As Workbook Dim shSAP As Worksheet Dim Dict As New Scripting.Dictionary Dim i As Long ' SAP sheet name is fixed and does not change Set wb = ActiveWorkbook Set shSAP = wb.Worksheets("SAP") ' i is the start row of the SAP sheet for data i = 2 ' Define null value as -1 SearchSAP = -1 Do While i < shSAP.UsedRange.Rows.Count And i < 106212 Dict.Add shSAP.Cells(i, 1).value, shSAP.Cells(i, 2).value i = i + 1 Loop Do While i < shSAP.UsedRange.Rows.Count And i < 106212 If Dict.Exists(StkCd) Then SearchSAP = Dict(StkCd) Exit Do End If i = i + 1 If i = 150000 Then Debug.Print "Break" End If Loop Set shSAP = Nothing Set wb = Nothing End Function 

但是这个function还是花了5分钟左右才弄明白。 我的问题是,我是以一种非常愚蠢的方式接近这个吗? 我怎样才能更有效地做到这一点? 我不是一个全职的程序员,所以我不知道我能做些什么来优化这个。 任何帮助将是伟大的!

 Public Function SearchSAP(StkCd As Long) As Long Static Dict As scripting.dictionary 'precerved between calls Dim i As Long, arr If Dict Is Nothing Then 'create and populate dictionary Set Dict = New scripting.dictionary With ActiveWorkbook.Worksheets("SAP") arr = .Range(.Range("A2"), _ .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 1)).Value End With For i = 1 To UBound(arr, 1) Dict.Add arr(i, 1), arr(i, 2) Next i End If If Dict.exists(cstr(StkCd)) Then SearchSAP = CLng(Dict(cstr(StkCd))) Else SearchSAP = -1 End If End Function