Goalseek для нескольких столбцов

Question

Я хочу, чтобы Goalseek проходил через несколько столбцов («BB: BP»). В настоящее время он работает со столбцом «BB» только следующим образом:

Значение в ячейке «BB63» изменяется, когда значение в ячейке «BB62» равно значению в ячейке «BB61».

Это код:

Sub Goalseek() 

    With Worksheets("sheet_input") 
     .Range("bc62").GoalSeek _ 
     Goal:=.Range("bc61").Value, _ 
     ChangingCell:=.Range("bc63") 
    End With 

End Sub 

Я хочу, чтобы создать цикл так, что он работает весь путь к колонке «BP», когда я бегу один макрос. Я придумал следующее:

Public Sub Goalseek() 
    Dim rngCol As Range 
    For Each rngCol In ActiveSheet.Range("BB61:BP63") 
    rngCol.Cells(54, 62).GoalSeek Goal:=rngCol.Cells(54, 61), ChangingCell:=rngCol.Cells(54, 63) 
    Next rngCol 
End Sub 

Но он не работает. Я получаю следующую ошибку:

Compile error: Only comments may appear after End Sub, End Function, or End Property

Что я делаю неправильно?

Answer 1

Давайте рассмотрим небольшой код для очистки, прежде чем обращаться к проблеме с ошибкой.

Когда вы определяете Range, объект .Cell определен относительно этого диапазона. Таким образом, .Cell(1, 1) фактически ссылается на первую ячейку вашего Range (т.е. «BB61») не весь Worksheet.

Так что ваш код может быть лучше следующим образом:

Sub Goalseek() 
    Dim rng as Range 
    Dim cell as Range 

    Set rng = ThisWorkbook.Worksheets("sheet input").Range("BB62:BP62") 
    For Each cell in rng.Cells 
     cell.GoalSeek Goal:=cell.Offset(-1).Value, ChangingCell:= cell.Offset(1) 
    Next 
End Sub 

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

Answer 2

Я нашел решение моей intial вопроса, а также два дополнительных вопроса, чтобы быть:

Sub Goalseek() 
    Dim rng As Range 
    Dim cell As Range 

Set rng = ThisWorkbook.Worksheets("pb_input").Range("BB62:BP62") 
    rng.Offset(1).Value = 0 
For Each cell In rng.Cells 
    If cell.Value <= cell.Offset(-1).Value Then _ 
    cell.Offset(2) = 1 Else _ 
    cell.Offset(2) = -1 
    cell.Goalseek Goal:=cell.Offset(-1).Value, ChangingCell:=cell.Offset(1) 
Next 
End Sub 

Answer 3

я нашел решение быть:

Sub GoalSeek() 
Dim rng As Range 
Dim cell As Range 

Application.ScreenUpdating = False 

Set rng = ThisWorkbook.Worksheets("pb_input").Range("BB62:BP62") 
rng.Offset(1).Value = 0 

For Each cell In rng.Cells 
    If cell.Value <= cell.Offset(-1).Value Then 
     cell.Offset(2) = 1 
    Else 
     cell.Offset(2) = -1 
    End If 

    If cell.Offset(-1) > 0 Then 
     cell.GoalSeek Goal:=cell.Offset(-1).Value, ChangingCell:=cell.Offset(1) 
    End If 
Next 

Application.ScreenUpdating = True 
End Sub