Условие, в котором осуществляется подбор значения через VBA

[Naturale]

Задание звучало так: Подбор параметров и построение графика. Значение в столбце 3 должно быть равно значению в столбце 2. Изменяется значение в столбце 5. Построить линейный график выручки. Результаты вывести в документ Word

Я сделал через подмену просто и подбор (не без помощи...), а нужно было составить условие, в котором будет расписано, что среднее значение в С4 будет меняться в зависимости от изменения ячейки Е4, так как в С4 пишется среднее значение диапазона от Е4 до АN4. Так же значение в С4, которое среднее, не должно быть равно В4, а приближенным должно быть, отличаться максимум на 10%. Через If, Then, Else, End If, Next. Проблема именно с условием, остальное работает...

PHP код:

Sub Макрос1()
    Range("C4").GoalSeek Goal:=50000, ChangingCell:=Range("E4")
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.ChartType = xlLine
    ActiveChart.SetSourceData Source:=Range("Лист1!$J$5:$AN$5")
 
    ActiveSheet.ChartObjects(1).Activate
    ActiveSheet.ChartObjects(1).Activate
    ActiveChart.ChartArea.Copy
    Set WApp = CreateObject("Word.Application")
    WApp.Visible = True
    Set Doc = WApp.Documents.Add
    WApp.Selection.TypeParagraph
    WApp.Selection.Paste
End Sub 


[Naturale]

Сделал так, но она не останавливается, есть у кого идеи?

PHP код:

 For i = Range("B4") - 10000 To Range("B4") + 10000
    Range("E4") = Range("E4") + 100
    If Range("C4") > 0.9 * Range("B4") Or Range("C4") < 0.9 * Range("B4") Then
    Exit For
    End If
    Next i 


[Naturale]

Вдруг кому понадобится, разобрался сам)

PHP код:

Sub exam()
For i = Range("B4") - 10000 To Range("B4") + 10000
    If Range("C4") < 0.9 * Range("B4") Then
            Range("E4") = Range("E4") + 100
            If Range("C4") > 0.9 * Range("B4") And Range("C4") < 1.1 * Range("B4") Then
            Exit For
        End If
    End If
    If Range("C4") > 1.1 * Range("B4") Then
            Range("E4") = Range("E4") - 100
            If Range("C4") > 0.9 * Range("B4") And Range("C4") < 1.1 * Range("B4") Then
            Exit For
        End If
    End If
Next i
        ActiveSheet.Shapes.AddChart.Select
        ActiveChart.ChartType = xlLine
        ActiveChart.SetSourceData Source:=Range("Лист1!$J$5:$AN$5")
        ActiveSheet.ChartObjects(1).Activate
        ActiveSheet.ChartObjects(1).Activate
        ActiveChart.ChartArea.Copy
        Set WApp = CreateObject("Word.Application")
        WApp.Visible = True
        Set Doc = WApp.Documents.Add
        WApp.Selection.TypeParagraph
        WApp.Selection.Paste
End Sub