Код VBA для копирования и вставки значения из определенной ячейки, которое изменяется во время выполнения макроса

Question

Я постараюсь (насколько я могу) объяснить код, который я использую

По сути, у меня есть Excel, который выводит значение в ячейку W151 на основе вычисления, которое зависит от ячеек в диапазоне Q149: Q182.

Первый шаг - сброс всех значений в диапазоне Q149: Q182 до базовых значений путем копирования и вставки из ячеек S149: S182.

На основе базовых значений для формулы я копирую и вставляю значение, выведенное в W151, в W99

Затем я изменяю значение в Q149 на "2". Это обновляет расчет и, следовательно, значение в ячейке W151, которое я затем копирую и вставляю в W100

Затем я изменяю Q150 на «2» и снова копирую значение из W151, на этот раз в W101 и т. Д. И т. Д.

У меня вопрос, есть ли способ задания ячеек, которые я изменяю как массив (выбранный пользователем через приглашение), выходная ячейка W151 как переменная (выбираемая пользователем через приглашение) и место назначения для скопированных значений (т. е. в настоящее время ячеек W99: W101) в виде массива, также выбранного пользователем через приглашение. Если нет, то можете ли вы подумать, что может автоматизировать этот процесс?

Я ценю, что, возможно, я плохо справился с объяснением того, что я пытаюсь сделать, поэтому, пожалуйста, не стесняйтесь просить разъяснений (хотя я предупреждаю вас, мои знания VBA очень ограничены)

Большое спасибо,

Thomas

Sub Example()

Range("S149:S182").Select
Selection.Copy
Range("Q149").Select
Selection.PasteSpecial Paste:=xlPasteValues
Range("W151").Select
Selection.Copy
Range("W99").Select
Selection.PasteSpecial Paste:=xlPasteValues
Range("Q149").Select
ActiveCell.FormulaR1C1 = "2"
Range("W151").Select
Selection.Copy
Range("W100").Select
Selection.PasteSpecial Paste:=xlPasteValues
Range("Q150").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "2"
Range("W151").Select
Selection.Copy
Range("W101").Select
Selection.PasteSpecial Paste:=xlPasteValues

End Sub

Answer 1

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

Sub Example()

Dim rng1 As Range
Dim rng2 As Range
Set rng1 = Application.InputBox("Select range1", Type:=8)
Set rng2 = Application.InputBox("Select range2", Type:=8)

With Sheets("Sheet1")
.Range("Q149:Q182").Value = rng1.Value
.Range("W99").Value = rng2.Value
.Range("Q149").FormulaR1C1 = "2"
.Range("W100").Value = rng2.Value
.Range("Q150").FormulaR1C1 = "2"
.Range("W101").Value = rng2.Value
End With

End Sub

Answer 2

Не совсем так, как я надеялся сделать, так как это все еще зависит от размещения значений на листе.

Нет одного шага, которого я не понял:

Исходя из базовых значений для формулы, я копирую и вставляю значение выводится на W151 в W99

Это делается до того, как вы установите первое значение в 2. Таким образом, в случае, когда базовое среднее значение переходит в W99, затем вы меняете первое значение на 2, и оно переходит в W100. т.е. если вы начнете с 34 значений в столбце Q, вы закончите с 35 значениями, скопированными в столбец W?

Sub Test()

    Dim CopyRng As Range
    Dim rCell As Range

    With ThisWorkbook.Worksheets("Sheet1")
        Set CopyRng = .Range("Q149:Q182")
        CopyRng.Value = .Range("S149:S182").Value

        .Range("W99").Value = .Range("W151").Value
        For Each rCell In CopyRng
            rCell.Value = 2
            'Q149 Offset by -49 rows and +6 columns = cell W100.
            rCell.Offset(-49, 6).Value = .Range("W151").Value
        Next rCell

    End With

End Sub  

Edit:
Чтобы попросить пользователя сделать выбор, вы можете использовать следующий метод.
Одна проблема, которая не была решена в этом коде, заключается в том, что пользователь нажимает Отмена , но, надеюсь, ссылка укажет вам правильное направление - мне понравился ответ, данный @ DirkReichel.

Sub Test()

    Dim CopyRng As Range
    Dim rCalculation As Range
    Dim rDestination As Range
    Dim rCell As Range

    'Creating the base values is a manual operation now.
    'CopyRng.Value = Sheet1.Range("S149:S182").Value

    Set CopyRng = Application.InputBox("Select range to be evaluated.", Type:=8) 'Q149:Q182

    'Calculation must be a single cell.
    Do
        Set rCalculation = Application.InputBox("Select cell containing calculation.", Type:=8) 'W151
    Loop While rCalculation.Cells.Count <> 1

    'First cell in destination must be a single cell.
    Do
        Set rDestination = Application.InputBox("Select first cell to be pasted to.", Type:=8) 'W99
    Loop While rDestination.Cells.Count <> 1

    rDestination.Value = rCalculation.Value
    For Each rCell In CopyRng
        rCell.Value = 2

        rDestination.Offset(rCell.Row - CopyRng.Row + 1).Value = rCalculation.Value
    Next rCell

End Sub

Answer 3

@ Томас, прежде всего, добро пожаловать!

Сделайте необходимые изменения (имя листа или диапазоны) и попробуйте:

Sub Example()

    With (Sheet1) '<= Change Sheet Name if needed
        .Range("S149:S182").Copy .Range("Q149")
        .Range("W151").Copy .Range("W99")
        .Range("W151").Copy .Range("W100")
        .Range("W151").Copy .Range("W101")
        .Range("Q149").value="2"
        .Range("Q150").value = "2"
    End With

End Sub