Сохранение первого значения в последовательности и использование сохраненных значений там, где выполняется условие

Question

У меня есть эта таблица, и код VBA должен извлечь значение из продукта, где основным значением является Да.Но значение должно быть первым значением в последовательности.

+---------+---------+---------+
| Product | Results | Primary |
+---------+---------+---------+
| A       |         |         |
| B       |         | Yes     |
| C       |         | Yes     |
| D       |         |         |
| E       |         | Yes     |
| F       |         |         |
| G       |         | Yes     |
| H       |         | Yes     |
| I       |         |         |
+---------+---------+---------+

Ожидаемые результаты:

+---------+---------+---------+
| Product | Results | Primary |
+---------+---------+---------+
| A       |         |         |
| B       | A       | Yes     |
| C       | A       | Yes     |
| D       |         |         |
| E       | D       | Yes     |
| F       |         |         |
| G       | F       | Yes     |
| H       | F       | Yes     |
| I       |         |         |
+---------+---------+---------+

Я пробовал это ниже код VBA, но не работает, как я ожидал.

Sub test()
    Dim i As Long
    Dim lr As Long

    lr = ActiveSheet.UsedRange.Rows.Count

    For i = 2 To lr
        If Range("D" & i).Value = "Yes" Then
            Range("C" & i).Value = Range("B" & i - 1).Value
        End If
    Next
End Sub

Answer 1

Формула Excel

Вот пример того, как может выглядеть ваша формула. Сначала проверяется, является ли основное поле « Да ». Если это так, то он проверяет, был ли предыдущий результат также положительным, и захватывает его, если это так. В противном случае он получает первое значение на основе вашего примера.

= IF ($ C2 = "Да", IF ($ C1 = "Да", $ B1, $ A1), "")

Отрегулируйте это при необходимости!

---

Код VBA

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

Я использовал вспомогательную функцию (Inject) для построения фактической формулы и облегчения чтения / отладки при возникновении проблем.

Не стесняйтесь также добавлять свою собственную обработку ошибок.

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

Option Explicit

Private Sub AddResultsToTable()

    Dim Ws As Worksheet
    Set Ws = ActiveSheet

    'FIND COLUMN HEADERS TO USE IN FORMULA REFERENCES
    With Ws.UsedRange

        On Error GoTo Catch
        Dim Product As Range
        Set Product = .Find("Product")

        Dim Results As Range
        Set Results = .Find("Results")

        Dim Primary As Range
        Set Primary = .Find("Primary")

    End With

    'CREATE FORMULA. Example: =IF($C2="Yes", IF($C1="Yes", $B1, $A1),"")
    Dim CustomFormula As String
    CustomFormula = Inject("=IF(${0}='Yes', IF(${1}='Yes', ${2}, ${3}),'')", _
        Primary.Offset(1).Address(False, True), _
        Primary.Address(False, True), _
        Results.Address(False, True), _
        Product.Address(False, True) _
    )

    'SET FIRST RANGE EQUAL TO FORMULA & AUTOFILL FORMULA DOWN
    With Results.Offset(1)
        .Value = CustomFormula
        .AutoFill Range(.Address, Ws.Cells(Ws.Rows.Count, Product.Column).End(xlUp).Offset(, 1))
    End With

Exit Sub
Catch:
    'You can do your error handling here.
    MsgBox Err.Description, vbCritical

End Sub


'METHOD THAT ALLOWS A STRING TO BE REPLACED WITH VARIABLES AND SPECIAL CHARACTERS
Public Function Inject(ByVal Source As String, ParamArray Args() As Variant) As String

    '@AUTHOR: ROBERT TODAR
    '@EXAMPLE: Inject("${0}, ${1}!", "Hello", "Robert") --> Hello, Robert!

    'REPLACE SINGLE QUOTES WITH DOUBLE QUOTES
    Inject = Source
    Inject = Replace(Inject, "'", """")

    'REPLACE ${#} WITH VALUES STORED IN THE VALUE IN THAT INDEX.
    Dim Index As Integer
    For Index = LBound(Args, 1) To UBound(Args, 1)
        Inject = Replace(Inject, "${" & Index & "}", Args(Index), , , vbTextCompare)
    Next Index

End Function

Answer 2

Предполагая, что cols ABC используют следующую формулу в B2

=If(C2="yes", if(B1="",A1,B1),"")

Скопируйте это на все строки ниже.

Это будет работать до тех пор, пока первый элемент не является основным.

U может даже включить эту формулу в vba и выполнить копирование в vba