请各位大佬帮忙看看如何提高运算速度？

付伟林

数据集有1000多列，每列有22800行，要查找数据集范围内c(20,3）组合出现的次数，有什么方法可以高效得到结果：以下代码运行速度太慢了。附上：


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