VBA，Excel 2013中的代码“无响应”，隐含于公式/新代码

Question

我下面的代码在excel 2010中可以很好地工作。我已经升级到2013，现在我的excel遇到了无法响应的问题，并且excel无法正常工作。

我尝试用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

任何建议将不胜感激。