VBA генерирует вывод: только данные, которые удовлетворяют определенным критериям в новом листе

Question

Я строю модель, которая в настоящее время выглядит следующим образом - лист ввода -> основные функции Excel -> лист вывода.Основные вещи правильно ?!

Я хочу сделать модель более динамичной, добавив вывод, сгенерированный VBA (Новый лист), только извлекая данные, которые удовлетворяют определенным критериям, исходя из следующего:

Sub GenerateTargets()
'Dim UpperRange As Double
'Dim LowerRange As Double
'Dim Percentile As Double
'Dim Test
'Dim Total Revenue {Note: [This is a header in the output sheet] [should I use Array or Range? If array is it Stat or Dynamic] I might change the input later on and increase the number of observations}


'Read Values in Cells
UpperRange = Worksheets("sheet2").Cells(x, y).Value
LowerRange = Worksheets("sheet2").Cells(x, y).Value

Test = UpperRange > Percentile > LowerRange

Case Test Is True
    [This is the test I want to generate]

Case Test Is False
    [I do not want this to show in my new sheet]

[Here I would like to add another Case to stop counting if [Total revenue = ##]

End Sub

Как мнепопросите его сгенерировать те же заголовки / данные в выходных данных, но исключить ложный регистр, в то же время прекратить считать, если он достигнет определенного порога.

Буду признателен за любую помощь / предложения -

Answer 1

Если я вас правильно понял, тогда посмотрите этот код. Вам не нужен Select Case, так как вы хотите выполнить код только тогда, когда «TEST» равен TRUE. Вы можете проверить состояние «ДОХОД» внутри цикла FOR. Вы можете использовать динамический массив для хранения ваших значений, а затем в конце записать в лист OUTPUT

Sub GenerateTargets()
    Dim UpperRange As Double, LowerRange As Double, Percentile As Double
    Dim Rev As Double
    Dim Test As Boolean
    Dim Output() As String

    Rev = Somevalue '<~~ Revenue

    '~~> Read Values in Cells
    UpperRange = Worksheets("sheet2").Cells(x, y).Value
    LowerRange = Worksheets("sheet2").Cells(x, y).Value

    '~~> Test Condition
    'Test = UpperRange > Percentile > LowerRange

    If Test = True Then
        '~~> Use For Loop here to store values in a dynamic array
        '~~> Use Redim Preserve to store new values

        '~~> Create a condition for revenue and exit FOR loop if
        '~~> the condition is met
        ' If Rev = 0 Then Exit For

        '~~> Store results in the output worksheet if the array is not empty
    End If
End Sub

СЛЕДОВАТЬ ВВЕРХ

Это то, что вы пытаетесь сделать? (КОД НЕ ПРОВЕРЕН при отсутствии файла примера). Я прокомментировал код, чтобы у вас не было проблем с его пониманием.

Option Explicit

Sub GenerateTargets()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim UpperRange As Double, LowerRange As Double, Percentile As Double
    Dim lastRowWs1 As Long, lastRowWs2 As Long, i as Long

    '~~> Sheet where data needs to be copied
    Set ws1 = Sheets("Sheet1")
    lastRowWs1 = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row + 1

    '~~> Sheet where the data needs to be compared
    Set ws2 = Sheets("Sheet2")
    '~~> Read Values in Cells
    UpperRange = ws2.Range("L2").Value
    LowerRange = ws2.Range("L3").Value
    lastRowWs2 = ws2.Range("A" & ws2.Rows.Count).End(xlUp).Row

    '~~> Starting from the 3rd row
    For i = 3 To lastRowWs2
        '~~> Get Percentile Value for comparision
        Percentile = ws2.Range("B" & i).Value

        '~~> Test Condition and proceed if true
        If UpperRange > Percentile And LowerRange < Percentile Then
            '~~> Copy range A to I from Sheet2 and paste it in Sheet1
            ws2.Range("A" & i & ":I" & i).Copy _
            ws1.Range("A" & lastRowWs1)
            lastRowWs1 = lastRowWs1 + 1
        End If
    Next i
    Application.CutCopyMode = False
End Sub