Excel 2013 中的代码“无响应”。转换为公式/新代码

Question

我有下面的代码可以在 Excel 2010 中运行。

我升级到 2013，现在遇到无响应问题。

我尝试用 16 个公式 EE2:ET6141 替换此代码。我发现这效率低下、耗时且占用大量内存。

公式来替换我的代码：

IF(AND(OR($BM:$BM="value1",$BM:$BM="value2",$BM:$BM="value3"),$BN:$BN<>"Excel",$BN:$BN<>"ITS"),$AT:$AT*(IFNA(VLOOKUP(EE$1&$S:$S,EQ_Shocks!E:F,2,FALSE),VLOOKUP(EE$1&"OTHERS",EQ_Shocks!E:F,2,FALSE))-1),"")

逻辑类似于：
对于 A1 = Stackoverflow、BM = value1 或 value2 或 value3 的每一行，并且 BN 不在 Excel 中，也不在 ITS 中。然后从 EQ_shocks 表中获取值。

代码

它在这一行出现无响应错误，If thisEqShocks(1, 1) = "#EMPTY" Then 我在该行放置了一个断点end if ，并且尝试循环这个大 if 语句需要很长时间或没有响应。

我还在 for 循环中注意到这一点，For thisScen = 1 To UBound(stressScenMapping, 1)需要很长时间才能通过断点进行响应，Next thisScen我可以肯定地说这是代码的这一部分。

Public Sub oldcode() 
    Application.ScreenUpdating = False

    Dim i As Long, thisScen As Long, nRows As Long, nCols As Long
    Dim stressWS As Worksheet

    Set stressWS = Worksheets("EQ_Shocks")
    Unprotect_Tab ("EQ_Shocks")
    nRows = lastWSrow(stressWS)
    nCols = lastWScol(stressWS)

    Dim readcols() As Long
    ReDim readcols(1 To nCols)

    For i = 1 To nCols
        readcols(i) = i
    Next i

    Dim eqShocks() As Variant
    eqShocks = colsFromWStoArr(stressWS, readcols, False)

    'read in database columns
    Dim dataWs As Worksheet
    Set dataWs = Worksheets("database")

    nRows = lastRow(dataWs)
    nCols = lastCol(dataWs)

    Dim dataCols() As Variant
    Dim riskSourceCol As Long
    riskSourceCol = getWScolNum("RiskSource", dataWs)

    ReDim readcols(1 To 4)
    readcols(1) = getWScolNum("RiskReportProductType", dataWs)
    readcols(2) = getWScolNum("Fair Value (USD)", dataWs)
    readcols(3) = getWScolNum("Source Currency of the CUSIP that is denominated in", dataWs)
    readcols(4) = riskSourceCol

    dataCols = colsFromWStoArr(dataWs, readcols, True)

    'read in scenario mappings
    Dim mappingWS As Worksheet
    Set mappingWS = Worksheets("mapping_ScenNames")

    Dim stressScenMapping() As Variant
    ReDim readcols(1 To 2): readcols(1) = 1: readcols(2) = 2
    stressScenMapping = colsFromWStoArr(mappingWS, readcols, False, 2) 'include two extra columns to hold column number for IR and CR shocks

    For i = 1 To UBound(stressScenMapping, 1)
        stressScenMapping(i, 3) = getWScolNum(stressScenMapping(i, 2), dataWs)
        If stressScenMapping(i, 2) <> "NA" And stressScenMapping(i, 3) = 0 Then
            MsgBox ("Could not find " & stressScenMapping(i, 2) & " column in database")
            Exit Sub
        End If
    Next i

    ReDim readcols(1 To 4): readcols(1) = 1: readcols(2) = 2: readcols(3) = 3: readcols(4) = 4
    stressScenMapping = filterOut(stressScenMapping, 2, "NA", readcols)

    'calculate stress and write to database
    Dim thisEqShocks() As Variant

    Dim keepcols() As Long
    ReDim keepcols(1 To UBound(eqShocks, 2))
    For i = 1 To UBound(keepcols)
        keepcols(i) = i
    Next i

    Dim thisCurrRow As Long

    For thisScen = 1 To UBound(stressScenMapping, 1)

        thisEqShocks = filterIn(eqShocks, 2, stressScenMapping(thisScen, 1), keepcols)

        If thisEqShocks(1, 1) = "#EMPTY" Then
            For i = 2 To nRows
                If dataCols(i, 4) <> "Excel" And dataCols(i, 4) <> "OBI" And (dataCols(i, 1) = "value1" Or dataCols(i, 1) = "value2") Then
                    dataWs.Cells(i, stressScenMapping(thisScen, 3)).Value = "No shock found"
                End If
            Next i
        Else                                     'calculate shocks
            Call quicksort(thisEqShocks, 3, 1, UBound(thisEqShocks, 1))
            For i = 2 To nRows
                If dataCols(i, 4) <> "Excel" And dataCols(i, 4) <> "ITS" And (dataCols(i, 1) = "value1" Or dataCols(i, 1) = "value2" Or dataCols(i, 1) = "value3") Then
                    thisCurrRow = findInArrCol(dataCols(i, 3), 3, thisEqShocks)
                    If thisCurrRow = 0 Then      'could not find currency so use generic shock
                        thisCurrRow = findInArrCol("OTHERS", 3, thisEqShocks)
                    End If
                    If thisCurrRow = 0 Then
                        dataWs.Cells(i, stressScenMapping(thisScen, 3)).Value = "No shock found"
                    Else
                        dataWs.Cells(i, stressScenMapping(thisScen, 3)).Value = Replace(dataCols(i, 2), "-", 0) * (thisEqShocks(thisCurrRow, 4) - 1)
                    End If
                End If
            Next i
        End If

    Next thisScen
    Application.ScreenUpdating = True
End Sub

添加快速排序功能

Sub quicksort(ByRef arr() As Variant, ByVal sortCol As Long, ByVal left As Long, ByVal right As Long)

    If right > left Then
        Dim pivotIndex As Long
        pivotIndex = left + Int((right - left) / 2)

        Dim pivotIndexNew As Long
        pivotIndexNew = partition(arr, sortCol, left, right, pivotIndex)
        Call quicksort(arr, sortCol, left, pivotIndexNew - 1)
        Call quicksort(arr, sortCol, pivotIndexNew + 1, right)
    End If

End Sub