excel - 我的匹配功能耗时太长(3 小时!!),需要其他建议
问题描述
正如标题所说,匹配功能花费的时间太长。一个电子表格有 100,000 行长,它有一堆证券,我需要确保它们在另一个有 800,000 行的电子表格上。下面是代码:
仅供参考,我在代码构建方面处于平均水平,所以我在阐述我的论点方面非常初级。
Option Explicit
'a lot of dims
StartTime = Timer
Set ShVar = ThisWorkbook.Worksheets("in1")
With wnewwqr
Set OutShVar = wnewwqr.Worksheets("First Sheet")
Set RngConcat = OutShVar.Range("B:B")
Set RngConcatISIN = OutShVar.Range("A:A")
Set OutShVar1 = wnewwqr.Worksheets("Second Sheet")
Set RngConcat1 = OutShVar1.Range("B:B")
Set RngConcatISIN1 = OutShVar1.Range("A:A")
End With
With ShVar
lastrow = .Cells(.Rows.Count, "H").End(xlUp).Row
End With
For i = 2 To lastrow
With ShVar
If .Range("O" & i).Value = "" Then
.Range("P" & i & ":Q" & i).Value = "No Security" 'Checking for no securities
Else
If Not IsError(Application.Match(.Range("O" & i).Value, RngConcat, 0)) Then
.Range("P" & i).Value = "US" ' writing US when it finds a US security in the confidential workbook
Else
.Range("P" & i).Value = "Not a US Security"
End If
End If
If .Range("P" & i).Value = "Not a US Security" Then
If Not IsError(Application.Match(.Range("O" & i).Value, RngConcat1, 0)) Then 'Only searching for securities if the first vlookup resulted in nothing and then it would go into the second sheet
.Range("Q" & i).Value = "US"
Else
.Range("Q" & i).Value = .Range("P" & i).Value
End If
End If
End With
Next i
SecondsElapsed = Round(Timer - StartTime, 2)
'Notify user in seconds
MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation
End Sub
更新:
我已经把所有东西都变成了变体,现在使用了 find 功能,但仍然没有我希望的那么快。大约花了14分钟。试运行 2000 行。我必须在 90,000 行上执行此操作
Option Explicit
Sub something
Dim lastrow As Long
Dim OutShVar As Worksheet
Dim ShVar As Worksheet
Dim WhatCell As Range
Dim i As Long
Dim TaskID As Variant
Dim confidentialfp As String
Dim confidential As String
Dim wconfidential As Workbook
Dim x As Variant
Set ShVar = ThisWorkbook.Worksheets("in1")
With ShVar
lastrow = .Cells(.Rows.Count, "H").End(xlUp).Row
End With
confidential = "confidential_2018-03-01 (Consolidated).xlsx"
Set wconfidential = Workbooks(confidential)
With wconfidential
Set OutShVar = .Worksheets("First Sheet")
End With
With ShVar
For i = 1 To lastrow
TaskID = ShVar.Range("O" & i).Value
Set x = .Range("A" & i)
Set WhatCell = OutShVar.Range("B:B").Find(TaskID, lookat:=xlWhole)
On Error Resume Next
x.Offset(0, 7).Value = WhatCell.Offset(0, 1)
Next i
End With
End Sub
解决方案
我不确定你是否完全理解 ScottCraner 的观点。他的意思是您应该将所有参考值(即证券的大列表)读入几个数组,并且您应该将输出值写入另一个数组。然后,您将在一个命令中将整个输出数组写入工作表。
将您的证券列表转换Collection
为具有非常快速的“查找”能力的证券也可能是值得的。有一些方法可以使这个速度更快,例如通过对证券进行分类,但你需要为此学习一些数学知识。
在下面的示例中,此框架代码显示了它是如何完成的。你应该知道,我没有费心将两个证券列表分成两个集合,所以如果你需要的话,你会想自己做。我还将所有测试表放在同一个工作簿上,因此根据需要调整工作表限定符:
Option Explicit
Sub RunMe()
Dim securities As Collection
Dim testSheet As Worksheet
Dim testItems As Variant
Dim i As Long
Dim exists As Boolean
Dim output() As Variant
'Read the first list of securities into the collection.
PopulateColumnCollection _
ThisWorkbook.Worksheets("First Sheet"), _
"B", _
securities
'Read the second list of securities into the collection.
'I've used the same collection in this example, you'll need
'to create two if you want separate columns in your output.
PopulateColumnCollection _
ThisWorkbook.Worksheets("Second Sheet"), _
"B", _
securities
'Read the test items into an array.
Set testSheet = ThisWorkbook.Worksheets("in1")
With testSheet
testItems = RangeTo2DArray(.Range( _
.Cells(2, "O"), _
.Cells(.Rows.Count, "O").End(xlUp)))
End With
'Prepare your output array.
'I've just used one column for output. If you want two then
'you'll need to resize the second dimension.
ReDim output(1 To UBound(testItems, 1), 1 To 1)
'Populate the output array based on the presence of
'a matching security.
For i = 1 To UBound(testItems, 1)
If IsEmpty(testItems(i, 1)) Then
output(i, 1) = "No Security"
Else
exists = False: On Error Resume Next
exists = securities(CStr(testItems(i, 1))): On Error GoTo 0
output(i, 1) = IIf(exists, "US", "Not a US Security")
End If
Next
'Write the output array to your sheet.
testSheet.Cells(2, "P").Resize(UBound(output, 1), UBound(output, 2)).Value = output
End Sub
Private Function RangeTo2DArray(rng As Range) As Variant
'Helper function to read range values into an array.
Dim v As Variant
Dim arr(1 To 1, 1 To 1) As Variant
v = rng.Value2
If Not IsArray(v) Then
arr(1, 1) = v
RangeTo2DArray = arr
Else
RangeTo2DArray = v
End If
End Function
Private Sub PopulateColumnCollection(ws As Worksheet, columnIndex As String, col As Collection)
'Helper sub to read a column of values into a collection.
Dim rng As Range
Dim v As Variant
Dim i As Long
With ws
Set rng = .Range( _
.Cells(1, columnIndex), _
.Cells(.Rows.Count, columnIndex).End(xlUp))
End With
v = RangeTo2DArray(rng)
If col Is Nothing Then Set col = New Collection
On Error Resume Next 'this avoids duplicates.
For i = 1 To UBound(v, 1)
col.Add True, CStr(v(i, 1))
Next
End Sub
推荐阅读
- .net-core - 如何在我的 Blazor 应用程序中将单选按钮标记为“已选中”,同时在 foreach 循环内创建单选按钮?
- selenium - Selenium 4 + geckodriver:使用 Page.printToPDF 将网页打印到 PDF
- mongodb - 使用 GoLang 从 MongoDB 读取文档
- python - Python 遍历行并更新 SQL Server 表
- python - 使用 Notebook tkinter 的不同选项卡
- javascript - 如何使用节点js、react js、sql中的会话以表格格式显示登录的用户详细信息?
- javascript - 根据其中一个属性的最大值从对象数组中获取一个对象
- google-cloud-platform - 多个文件的云函数 gcp 存储桶事件
- r - 使用 Lavaan 的 CFA 中复杂指标的 Rsquared 值
- freemarker - 如何以正常方式过早结束 FreeMarker 处理?