Автоматизация процесса копирования-вставки в Excel вместе со смещением

#vba

#vba

Вопрос:

Я хочу скопировать значения диапазона N17: N18 и вставить, транспонировав их в другую ячейку. Однако после выполнения того же самого я хочу сместить одну строку и вставить значение данного диапазона в новую активную ячейку. Я использую функцию решения данных, поэтому я хочу вставлять каждое новое значение N17: N18 для каждого нового ограничения.

Ниже приведены шаги, которые я хочу рассмотреть:

  1. скопируйте диапазон N17: N18, вставьте в N21-смещение 1 строки
  2. запустите функцию solver для получения новых значений
  3. вставить в N22 (N21-смещение на 1 строку)
  4. запустите функцию solver для получения новых значений
  5. вставить в N23 (N22-смещение на 1 строку)

это продолжается для всех новых значений…..

Комментарии:

1. Пожалуйста, покажите образец dta, желаемый результат и поделитесь с нами тем, что вы уже пробовали.

Ответ №1:

Если вы хотите сделать это вручную, выберите требуемый диапазон значений на листе Excel и нажмите Ctrl C для копирования

Затем выберите место, куда вы хотите вставить, щелкните правой кнопкой мыши «Вставить специальный», а затем установите флажок «транспонировать».

Скриншот с шагами

Если вы ищете программное решение, то я предлагаю макросы Excel (пожалуйста, измените его на нужные вам ячейки). Надеюсь, это поможет.

 Sub transpose_selection()
    Range("A1:C4").Select
    Selection.Copy
    Range("E1").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
End Sub
  

Ответ №2:

Я новичок в программировании на VBA, поэтому спасибо, что разрешили мои сомнения.

Повозившись с кодом, я смог найти решение. Вот оно, надеюсь, это кому-то поможет.

 Sub SolverShortcut()
'
' SolverShortcut_PasteSpecial-ValuesandTranspose Macro
'
' Keyboard Shortcut: Ctrl l
'
    SolverOk SetCell:="$N$17", MaxMinVal:=1, ValueOf:=0, ByChange:="$P$2:$P$6", _
        Engine:=1, EngineDesc:="GRG Nonlinear"
    SolverAdd CellRef:="$N$17", Relation:=2, FormulaText:="$P$16"
    SolverOk SetCell:="$N$17", MaxMinVal:=1, ValueOf:=0, ByChange:="$P$2:$P$6", _
        Engine:=1, EngineDesc:="GRG Nonlinear"
    SolverOk SetCell:="$N$17", MaxMinVal:=1, ValueOf:=0, ByChange:="$P$2:$P$6", _
        Engine:=1, EngineDesc:="GRG Nonlinear"
    SolverSolve
    '
' PasteSpecial_valuesandtranspose Macro
'
' Keyboard Shortcut: Ctrl l
'
    Range("N17:N18").Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    ActiveCell.Offset(1, 0).Select
End Sub
  

ЛЮБАЯ ФОРМА КОНСТРУКТИВНОЙ КРИТИКИ ВСЕГДА ПРИВЕТСТВУЕТСЯ.