Макрос подбора определённых цифр

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос подбора определённых цифр (Макросы/Sub)

MaxsimС

Дата: Понедельник, 03.11.2014, 23:16 | Сообщение № 1

Группа: Пользователи

Ранг: Прохожий

Сообщений: 3

Репутация: 0 ±

Замечаний: 0% ±

Excel 2003

Добрый вечер.
Вообщем тут такая проблемака. Нужно сделать макрос, я не прошу сделать его за меня, а хотя бы дать понять, как что и куда.
Красная клетка - число которое будет заданно изначально в условии мы его не трогаем. К примеру 75.
Жёлтая клетка - число которое будем мы подставлять в ручную. В зависимости от этого числа идёт сам расчёт всех зелёных клеток. Так как в зелёных клетках сами формулы, мы их не изменяем.
В последней синей клетке конечное число расчёта и оно должно совпасть с данным в условии числом.

Исходя из всего написанного выше, нужно сделать так что бы это число ( в жёлтой клетке "9" ), подбиралось само что бы число в синей совпадало с заданным(красным "75")

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

К сообщению приложен файл: 5532762.xls (33.5 Kb)

Сообщение отредактировал MaxsimС - Понедельник, 03.11.2014, 23:30

Ответить

Pelena

Дата: Понедельник, 03.11.2014, 23:36 | Сообщение № 2

Группа: Админы

Ранг: Местный житель

Сообщений: 19188

Репутация: 4421 ±

Замечаний: ±

Excel 365 & Mac Excel

Здравствуйте.
Обязательно макрос? Подбор параметра или поиск решения не подойдёт?

К сообщению приложен файл: 3100910.xls (87.5 Kb)

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816

Ответить

sorcerer

Дата: Понедельник, 03.11.2014, 23:37 | Сообщение № 3

Группа: Пользователи

Ранг: Новичок

Сообщений: 38

Репутация: 6 ±

Замечаний: 0% ±

Excel 2010

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

.проанализировал ваши цифьры в формульной форме. Вам нужно сначало на бумага привести все к одной формуле, дабы искомое было желтое. А потом и VBA не нужен

Сообщение отредактировал sorcerer - Понедельник, 03.11.2014, 23:46

Ответить

MaxsimС

Дата: Понедельник, 03.11.2014, 23:47 | Сообщение № 4

Группа: Пользователи

Ранг: Прохожий

Сообщений: 3

Репутация: 0 ±

Замечаний: 0% ±

Excel 2003

Pelena, увы, такой способ не подойдёт... Так как было сказано макросом...
До этого момента я даже и понятия не имел что такое макрос и с чем его едят... Полазив и почитав я понял что лучше стоит написать вам на форум так как в этом полный 0...
Если бы Вам было не сложно помочь был бы крайне признателен...

Ответить

sorcerer

Дата: Вторник, 04.11.2014, 00:23 | Сообщение № 5

Группа: Пользователи

Ранг: Новичок

Сообщений: 38

Репутация: 6 ±

Замечаний: 0% ±

Excel 2010

MaxsimС,
1. Точность ( до какой цифры после запятой)?
2. Простой перебор подойдет?

Как-то так

К сообщению приложен файл: 3046117.xls (39.0 Kb)

Сообщение отредактировал sorcerer - Вторник, 04.11.2014, 02:13

Ответить

alex77755

Дата: Вторник, 04.11.2014, 08:50 | Сообщение № 6

Группа: Проверенные

Ранг: Обитатель

Сообщений: 362

Репутация: 64 ±

Замечаний: 0% ±

sorcerer,
Лихо!
Инструкцию бы приложил как найти 'C:\Users\Станислав\Downloads\Подбор значения.xlsm'!Podbor

Могу помочь в VB6, VBA
Alex77755@mail.ru

Ответить

alex77755

Дата: Вторник, 04.11.2014, 09:25 | Сообщение № 7

Группа: Проверенные

Ранг: Обитатель

Сообщений: 362

Репутация: 64 ±

Замечаний: 0% ±

[vba]

Код

Sub PODBOR()
Dim X, X1, X2, X3, T1, T2, T3
X = [g1]
Randomize
Do ' подбираем пару чисел окружая искомое
X1 = Int(100 * Rnd)
[c7] = X1
T1 = [c13]
DoEvents
X2 = Int(100 * Rnd)
[c7] = X2
   T2 = [c13]
Loop While (X - T1) * (X - T2) > 0

Do ' методом половинного деления подбираем
    X3 = (X1 + X2) / 2
    [c7] = X3
    T3 = [c13]
    If (X - T1) * (X - T3) < 0 Then
     X2 = X3
    End If
    If (X - T3) * (X - T2) < 0 Then
     X1 = X3
    End If
    DoEvents
    Loop While Abs(X - T3) > 0.000001
    MsgBox "X = " & X1, 64, CDec(Abs(X - T3))
End Sub

[/vba]