Код Excel VBA (поиск цели) Упрощение кода - PullRequest
1 голос
/ 18 февраля 2020

Я абсолютный новичок в VBA - все, что я до сих пор "кодировал", получено исключительно из функции Record Macro. Макрос работает, но он невероятно неуклюжий. По сути, я пытаюсь запустить функцию поиска цели, взять этот ответ и поместить его в ячейку. Затем я увеличиваю значение до следующего ввода и повторяю процесс (а затем еще 38 раз). Вот первые 2 приращения:

Range("B11").Select
    ActiveCell.FormulaR1C1 = "=R[-8]C[13]"
    Range("C37:D37").Select
    Range("C37").GoalSeek Goal:=0, ChangingCell:=Range("A33")
    Range("A33:B37").Select
    Selection.Copy
    Range("P3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("R11").Select

Range("B11").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=R[-7]C[13]"
    Range("C37:D37").Select
    Range("C37").GoalSeek Goal:=0, ChangingCell:=Range("A33")
    Range("A33:B37").Select
    Selection.Copy
    Range("P4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("P5").Select

C37: D37 - моя формула для поиска цели, а A33: B37 - вывод, который я затем копирую и вставляю в столбец P. Я хотел бы поделиться этим кодом с некоторыми коллегами, но в его нынешнем состоянии он выглядит очень непрофессионально. Есть идеи?

Спасибо!

1 Ответ

3 голосов
/ 18 февраля 2020

Pᴇʜ - спасибо за ответ; просто, но эффективно. Это то, что мне было нужно. На случай, если кто-нибудь в будущем столкнется с этим, вот что я в итоге использовал.

Sub Calculation()

Dim x As Long

For x = 1 To 40 
ThisWorkbook.Worksheets("Sheet1").Range("B11").Value = ThisWorkbook.Worksheets("Sheet1").Cells(2 + x, 15)
ThisWorkbook.Worksheets("Sheet1").Range("C37").GoalSeek Goal:=0, ChangingCell:=ThisWorkbook.Worksheets("Sheet1").Range("A33")
ThisWorkbook.Worksheets("Sheet1").Cells(2 + x, 16) = ThisWorkbook.Worksheets("Sheet1").Range("A33").Value 

Next

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...