|
|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
数据集有1000多列，每列有22800行，有什么方法可以高效得到结果：以下代码运行速度太慢了。附代码如下：
Sub CountCombinationsOptimized57()
Dim ws As Worksheet
Dim ds As Worksheet
Dim i As Long, j As Long, k As Long, l As Long
Dim combination As Double
Dim count As Long
Dim resultsRow As Long
Dim wsValue1 As Variant, wsValue2 As Variant, wsValue3 As Variant
Dim columnArrays() As Variant ' 用于存储ds工作表中每列值的数组
Dim columnData As Range
Dim matchResult As Variant
Dim lastRowDs As Long
Set ws = ThisWorkbook.Sheets("data")
Set ds = ThisWorkbook.Sheets("3d")
lastRowDs = 22800 'ds.Cells(ds.Rows.count, 1).End(xlUp).row
For resultsRow = 1002 To 1200
ReDim columnArrays(1 To resultsRow - 1)
For searchColumn = 1 To resultsRow - 1
Set columnData = ds.Columns(searchColumn).Resize(lastRowDs, 1) ' 确保只选取一列
columnArrays(searchColumn) = columnData.Value2 ' 使用.Value2
Next searchColumn
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For i = 1 To 80
For j = 1 To 18
wsValue1 = ws.Cells(resultsRow, 2 + j).value
For k = j + 1 To 19
wsValue2 = ws.Cells(resultsRow, 2 + k).value
For l = k + 1 To 20
wsValue3 = ws.Cells(resultsRow, 2 + l).value
combination = wsValue1 * 1000000 + wsValue2 * 10000 + wsValue3 * 100 + i
For searchColumn = 1 To UBound(columnArrays)
matchResult = Application.Match(combination, columnArrays(searchColumn), 0)
If Not IsError(matchResult) Then
count = count + 1
End If
Next searchColumn
Next l
Next k
Next j
ds.Cells(22800 + i, resultsRow).value = count
count = 0
Next i
Next resultsRow
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub |
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2024-5-7 17:10
楼主