vba - VBA/公式，工作表之间的映射

问题描述

我有一个代码在 excel 2013 上运行时遇到问题。2010 工作正常。

我一直在考虑只做公式，因为我无法让它发挥作用。

这是逻辑

如果存在这种情况，则仅在工作表 X 中填写值：在工作表 A 中，如果列 a = 值 1 、值 2 或值 3 且列 b <> 值 4、<> 值 5
然后从工作表 X 到工作表 Y 中查找标题。这些标题将在工作表 Y 列 c 中。
对于与工作表 Y col c 匹配的标题，查找工作表 X.列 c 和工作表 Y.列 d 的类似数据。将这些用作表 Y 中下一列的查找。对于不匹配的地方，使用“其他”作为值。
对于匹配的标题/列，返回工作表 Y 列 e（值）并乘以工作表 X。列 d。减一。
将所有这些值返回到标题所在的表格 a 中。

Sheet X（实际上将计算堆栈和溢出列中的以下公式）

+-------------+-------------+------------+-------+-----------------+-------------+
|  conditions | condition 2 | currency   | value |     stack       |  overflow   |
+-------------+-------------+------------+-------+-----------------+-------------+
| value 1     | value 10    | USD        |   100 | 100 * (.75 - 1) |             |
| value 2     | value 7     | XRP        |   200 | 200 * (.50 - 1) |             |
| value 3     | value 8     | USD        |   300 |                 | 300*(.65-1) |
| value 1     | value 9     | XRP        |   400 |                 | 400*(.24-1) |
+-------------+-------------+------------+-------+-----------------+-------------+

表 Y

+----------+----------+--------+
| header   | currency |  value |
+----------+----------+--------+
| stack    | USD      |    .75 |
| stack    | OTHER    |    .50 |
| overflow | USD      |    .65 |
| overflow | OTHER    |    .24 |
+----------+----------+--------+

此代码在代码底部的 for 循环处变慢。

这是我的代码：

Public Sub calc()

    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("condition 2", dataWs)

    ReDim readcols(1 To 4)
    readcols(1) = getWScolNum("value", dataWs)
    readcols(2) = getWScolNum("currency", dataWs)
    readcols(3) = getWScolNum("condition", 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) <> "value 4" And dataCols(i, 4) <> "value 5" And (dataCols(i, 1) = "value 1" Or dataCols(i, 1) = "value 2") 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) <> "value 5" And dataCols(i, 4) <> "value 6" And (dataCols(i, 1) = "value 1" Or dataCols(i, 1) = "value 2" Or dataCols(i, 1) = "value 3") 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

标签： vbaexcel

这是一个仅公式的解决方案，使用辅助列一次查找 2 个条件（标题和列）：

在工作表 Y 列 E 中添加一个辅助列，如下所示。在 E 中使用以下公式：
```
=C:C&D:D
```
在 E2 中使用以下公式并向下和向右复制：
```
=IF(AND(OR($A:$A="value 1",$A:$A="value 2",$A:$A="value 3"),$B:$B<>"value 4",$B:$B<>"value 5"),$D:$D*(IFNA(VLOOKUP(E$1&$C:$C,'Sheet Y'!$E:$F,2,FALSE),VLOOKUP(E$1&"OTHER",'Sheet Y'!$E:$F,2,FALSE))-1),"")
```
公式的计算部分
```
$D:$D*(IFNA(VLOOKUP(E$1&$C:$C,'Sheet Y'!$E:$F,2,FALSE),VLOOKUP(E$1&"OTHER",'Sheet Y'!$E:$F,2,FALSE))-1)
```
在辅助列中查找“标题”和 C 列的组合。如果找到组合，则返回其值，如果没有，则查找“header”和“OTHER”的组合并返回其值以执行计算。

这IF(AND(OR部分是您问题中第 1 点的条件。

vba - VBA/公式，工作表之间的映射

问题描述

解决方案

推荐阅读