Блог

Я написал код, в котором я пытаюсь использовать две разные формулы с набором условий, например, если мы принимаем во внимание валюту RUZ. там, где у нас есть значения между (SW- 1Y), формула должна быть = 1 / (1 / R208C [-5] RC12 / 10000), а для остальных значений (2Y, 3Y, 5Y) формула должна быть = 1 * RC [-5]. это условие выполняется толькоприменимо к RUZ ccy, в остальном для всех их соответствующих типов будет использоваться одна формула на ccy (валюту).

формула помещается в столбец P, теноры помещаются в столбец B

 Sub Get_vpl()
    
    ' Define Constants.
    
    Const wsName As String = "DS"
    Const FirstRow As Long = 5
    Const srcCol As String = "A"
    Const tgtCol As String = "P"
    Dim Criteria As Variant
    Dim Formulas As Variant
    Criteria = Array("RUB", "TRY", "TWD", "UAH", "UYU", "VND") ' add more...
    Formulas = Array( "=1/(1/R208C[-5] RC12/10000)", "=1*RC[-5]", "=1/(1/R232C[-5] RC12/1)", "=1*RC[-5]", "=1*RC[-5]", "=1*RC[-5]") ' add more...
    
    ' Define the Source Column Range.
    
    ' Define workbook.
    Dim wb As Workbook
    Set wb = ThisWorkbook
    ' Define worksheet.
    Dim ws As Worksheet
    Set ws = wb.Worksheets(wsName)
    ' Calculate Last Non-Empty Row.
    Dim LastRow As Long
    LastRow = ws.Cells(ws.Rows.Count, srcCol).End(xlUp).Row
    ' Define Source Column Range.
    Dim rng As Range
    Set rng = ws.Range(ws.Cells(FirstRow, srcCol), ws.Cells(LastRow, srcCol))
    
    ' Prepare to write to Target Column Range.
     
    ' Calculate Column Offset.
    Dim ColOffset As Long
    ColOffset = ws.Columns(tgtCol).Column - ws.Columns(srcCol).Column
    
    ' Declare variables.
    Dim CurPos As Variant ' Current Position
    Dim cel As Range      ' Current Cell Range
    
    ' Write formulas to Target Column Range.
   
    Application.ScreenUpdating = False
    ' Iterate the cell ranges in Source Range.
    For Each cel In rng.Cells
        ' Check if Current Cell Range in Source Column Range is not empty.
        If Not IsEmpty(cel) Then
            ' Try to find the value in Current Cell Range in Criteria Array
            ' and write the position to Current Position
            CurPos = Application.Match(cel, Criteria, 0)
            ' Check if value in Current Cell Range has been found
            ' in Criteria Array.
            If Not IsError(CurPos) Then
                ' Write formula from Formulas Array to current Target Cell
                ' Range, using Current Position in Criteria Array.
                cel.Offset(, ColOffset).Formula = _
                  Application.Index(Formulas, CurPos)
            End If
        End If
    Next cel
    Application.ScreenUpdating = True
    
    
End Sub
  

Я сделал больше, чем предполагалось, для вашего кода, потому что мне было так трудно понять, что вам нужно. Тем не менее, я довольно доволен результатом и надеюсь, что вы тоже будете. Обратите внимание, что я никогда не запускал код, и поэтому он может содержать незначительные ошибки или опечатки, которые я буду рад исправить, если вы укажете на них.

 Option Explicit

Enum Nws                ' worksheet navigation
    NwsFirstRow = 5
    NwsCcy = 1          ' Columns: A = Currency
    NwsTenor            '          B = Tenor
    NwsTarget = 16      '          P = Target
End Enum

Sub Get_vpl()
    ' 116
    
    ' Define Constants.
    Const wsName    As String = "DS"
    
    ' Declare variables.
    Dim Wb          As Workbook
    Dim Ws          As Worksheet
    Dim CcyIdx      As Integer              ' return value from CurrencyIndex()
    Dim R           As Long                 ' loop counter: rows
    
    Set Wb = ThisWorkbook
    Set Ws = Wb.Worksheets(wsName)
    Application.ScreenUpdating = False
    With Ws
        ' this syntax is easier because you need the row number R
        For R = NwsFirstRow To .Cells(.Rows.Count, NwsCcy).End(xlUp).Row
            CcyIdx = CurrencyIndex(.Cells(R, NwsCcy).Value)
            If CcyIdx >= 0 Then
                .Cells(R, NwsTarget).Formula = ChooseFormula(CcyIdx, .Cells(R, NwsTenor).Value)
            End If
        Next R
    End With
    Application.ScreenUpdating = True
End Sub

Private Function ChooseFormula(ByVal CcyIdx As Integer, _
                               ByVal Tenor As String) As String
    ' 116
    ' return the formula specified by Idx or Formula(0)
    
    Dim Idx             As Integer
    Dim Formula(2)      As String

    ' the advantage of the syntax you chose is that the array
    ' is dimensioned automatically.
    ' Here the advantage is clarity.
    Formula(0) = "=1*RC[-5]"
    Formula(1) = "=1/(1/R208C[-5] RC12/10000)"
    Formula(2) = "=1/(1/R232C[-5] RC12/1)"
    
    If CcyIdx = 0 Then
        If InStr("1Y,2Y,3Y,5Y", Tenor) Then Idx = 1
    End If
    ChooseFormula = Formula(Idx)
End Function

Private Function CurrencyIndex(ByVal Currcy As String) As Integer
    ' 116
    ' return -1 if not found or blank

    Dim Ccy()       As String               ' list of currencies
    Dim i           As Integer
    
    ' I added "RUZ" in position 0 (change to suit and match in ChooseFormula())
    ' this syntax uses less space but doesn't support MATCH()
    Ccy = Split("RUZ RUB TRY TWD UAH UYU VND")  ' add more...
    If Len(Trim(Currcy)) Then
        For i = UBound(Ccy) To 0 Step -1
            If StrComp(Currcy, Ccy(i), vbTextCompare) = 0 Then Exit For
        Next i
    Else
        i = -1
    End If
    CurrencyIndex = i
End Function
  

Я нашел ваши критерии довольно бесполезными в этом контексте. Возможно, именно поэтому я дал ему задание. Функция CurrencyIndex() возвращает номер индекса текущей валюты и впоследствии использует этот номер вместо фактического кода валюты. Для этой цели я добавил «RUZ» в ваш массив. У меня это на первой позиции, но подойдет и любое другое число.

Пожалуйста, посмотрите на функцию ChooseFormula() . Кажется, у вас есть только 3 формулы. Я присвоил индекс 0 наиболее распространенному и установил его по умолчанию. Для остальной части он CcyIdx передается функции в качестве аргумента, и если этот индекс = 0, он идентифицирует «RUZ» и придает ему особую обработку. Я не уверен, что назначенное мной лечение на 100% правильное или работоспособное, но я думаю, что код прост, и вы сможете изменять его по мере необходимости. Обратите внимание, что функция никогда не вернется Formula(2) в своем текущем состоянии, но вы можете легко изменить ее, чтобы учесть все виды условий и множество других возможных формул. Дайте мне знать, если вам нужна какая-либо помощь в этом.