Добрый день, уважаемые. В очередной раз требуется ваша помощь. Есть диапазон F9:N20 , который необходимо заполнить случайными числами от 0 до 2. Условия заполнения: Сумма чисел в F9:F20 должна равняться значению F6, сумма чисел F9:N9 должна равняться значению E9 Сумма чисел в G9:G20 должна равняться значению G6, сумма чисел F10:N10 должна равняться значению E10 и так далее..
Пробовал решить поочередным заполнением строк и столбцов (уменьшая диапазон), но в итоге понял, что такое решение не "прокатит", макрос зацикливается. Задача чем-то похожа на судоку. Нашел несколько вариантов решения судоку на ВБА, но, если быть откровенным, открыв код я не смог даже приблизительно понять, как он работает. Соответственно не могу применить для решения своей задачи.
Буду благодарен за любую помощь или подсказку.
В вложении сама таблица + мой кривой код, который зацикливается (потому как там есть Loop While).
Добрый день, уважаемые. В очередной раз требуется ваша помощь. Есть диапазон F9:N20 , который необходимо заполнить случайными числами от 0 до 2. Условия заполнения: Сумма чисел в F9:F20 должна равняться значению F6, сумма чисел F9:N9 должна равняться значению E9 Сумма чисел в G9:G20 должна равняться значению G6, сумма чисел F10:N10 должна равняться значению E10 и так далее..
Пробовал решить поочередным заполнением строк и столбцов (уменьшая диапазон), но в итоге понял, что такое решение не "прокатит", макрос зацикливается. Задача чем-то похожа на судоку. Нашел несколько вариантов решения судоку на ВБА, но, если быть откровенным, открыв код я не смог даже приблизительно понять, как он работает. Соответственно не могу применить для решения своей задачи.
Буду благодарен за любую помощь или подсказку.
В вложении сама таблица + мой кривой код, который зацикливается (потому как там есть Loop While).SkyPro
К сожалению есть дополнительные условия, которые Сольвер не принимает и колчичество ячеек условий больше 200 (файл примера "обрезан"). Кто может помочь в решении задачи посредством ВБА?
К сожалению есть дополнительные условия, которые Сольвер не принимает и колчичество ячеек условий больше 200 (файл примера "обрезан"). Кто может помочь в решении задачи посредством ВБА?SkyPro
skypro1111@gmail.com
Сообщение отредактировал SkyPro - Среда, 03.07.2013, 13:40
Есть диапазон F9:N82 , который необходимо заполнить случайными числами от 0 до 2. Условия заполнения: Сумма чисел в F9:F82 должна равняться значению F6, сумма чисел F9:N9 должна равняться значению E9 Сумма чисел в G9:G82 должна равняться значению G6, сумма чисел F10:N10 должна равняться значению E10 Столбцы разделены на группы KK и SV&CO. На пересечении столбцов с значением КК (диапазон F4:N4) и строк с значением SV&CO (D9:D82) проставляются 0.
третий день бьюсь над этим =\
Есть диапазон F9:N82 , который необходимо заполнить случайными числами от 0 до 2. Условия заполнения: Сумма чисел в F9:F82 должна равняться значению F6, сумма чисел F9:N9 должна равняться значению E9 Сумма чисел в G9:G82 должна равняться значению G6, сумма чисел F10:N10 должна равняться значению E10 Столбцы разделены на группы KK и SV&CO. На пересечении столбцов с значением КК (диапазон F4:N4) и строк с значением SV&CO (D9:D82) проставляются 0.
На пересечении столбцов с значением КК (диапазон F4:N4) и строк с значением SV&CO (D9:D82) проставляются 0
А наоборот (на пересечении строк KK и столбцов SV&CO) - тоже 0? Если так - то сортируем столбцы и строки по группам - и тогда каждая группа решается через ПоискРешения. Даже если только одно условие (строки KK и столбцы SV&CO) - то достаточно для ПоискРешения прописывать не просто СУММ(), а СУММЕСЛИ(), где условие как раз и будет проверять необходимость суммирования ячейки (т.е. мы не суммируем те самые строкаKK-столбецSV, где и так ноль, не влияющий на сумму).
Цитата (SkyPro)
На пересечении столбцов с значением КК (диапазон F4:N4) и строк с значением SV&CO (D9:D82) проставляются 0
А наоборот (на пересечении строк KK и столбцов SV&CO) - тоже 0? Если так - то сортируем столбцы и строки по группам - и тогда каждая группа решается через ПоискРешения. Даже если только одно условие (строки KK и столбцы SV&CO) - то достаточно для ПоискРешения прописывать не просто СУММ(), а СУММЕСЛИ(), где условие как раз и будет проверять необходимость суммирования ячейки (т.е. мы не суммируем те самые строкаKK-столбецSV, где и так ноль, не влияющий на сумму).AndreTM
Skype: andre.tm.007 Donate: Qiwi: 9517375010
Сообщение отредактировал AndreTM - Среда, 03.07.2013, 15:28
А наоборот (на пересечении строк KK и столбцов SV&CO) - тоже 0?
Нет, только на пересечении столбцов KK и строк SV&CO 100% проставляется 0. В других случаях - рандомное значение от 0 до 2.
Вариант с коллекцией на первые три столбца =\
[vba]
Код
Sub ras() Dim col1 As New Collection Dim col2 As New Collection Dim col3 As New Collection
Dim range1 As Range, cel1 As Range Dim Min As Double, Max As Double Dim i As Long Dim col1Range Min = 0 Max = 2 c = 0
Set range1 = Sheets("1").Range("d9:d82")
For Each cel1 In range1 If cel1.Value = "SV&CO" Then Range(cel1.Offset(0, 2), cel1(1, 5)).Formula = 0 End If Next
For Each cel1 In range1 If cel1.Value = "KK" Then col1.Add cel1.Offset(0, 2).Address col2.Add cel1.Offset(0, 3).Address col3.Add cel1.Offset(0, 4).Address 'col1.Add Range(cel1.Offset(0, 2), cel1(1, 5)).Address '\либо такой вариант End If
Next
Do
For i = 1 To col1.Count Set col1Range = Range(col1(i)) For Each cel1 In col1Range cel1.Value = Int((Max - Min + 1) * Rnd + Min) Next
Next c = c + 1 Loop While Range("f84").Value <> Range("f6").Value
Do
For i = 1 To col2.Count Set col1Range = Range(col2(i)) For Each cel1 In col1Range cel1.Value = Int((Max - Min + 1) * Rnd + Min) Next
Next c = c + 1 Loop While Range("g84").Value <> Range("g6").Value
Do
For i = 1 To col3.Count Set col1Range = Range(col3(i)) For Each cel1 In col1Range cel1.Value = Int((Max - Min + 1) * Rnd + Min) Next
Next c = c + 1 Loop While Range("h84").Value <> Range("h6").Value MsgBox c & "циклов пока подобрало значения" End Sub
[/vba]
Поиск решения по группам с сортировкой дает не тот результат, что необходим: К примеру три строки из группы заполнены просто нулями, а остальные проставлены единицы. А необходимо случайное распределение включающее в себя и двойки. + ограничение на кол-во ячеек в "поиск решения".. + нужно все организовать "нажатием одной кнопки" =\
Цитата (AndreTM)
А наоборот (на пересечении строк KK и столбцов SV&CO) - тоже 0?
Нет, только на пересечении столбцов KK и строк SV&CO 100% проставляется 0. В других случаях - рандомное значение от 0 до 2.
Вариант с коллекцией на первые три столбца =\
[vba]
Код
Sub ras() Dim col1 As New Collection Dim col2 As New Collection Dim col3 As New Collection
Dim range1 As Range, cel1 As Range Dim Min As Double, Max As Double Dim i As Long Dim col1Range Min = 0 Max = 2 c = 0
Set range1 = Sheets("1").Range("d9:d82")
For Each cel1 In range1 If cel1.Value = "SV&CO" Then Range(cel1.Offset(0, 2), cel1(1, 5)).Formula = 0 End If Next
For Each cel1 In range1 If cel1.Value = "KK" Then col1.Add cel1.Offset(0, 2).Address col2.Add cel1.Offset(0, 3).Address col3.Add cel1.Offset(0, 4).Address 'col1.Add Range(cel1.Offset(0, 2), cel1(1, 5)).Address '\либо такой вариант End If
Next
Do
For i = 1 To col1.Count Set col1Range = Range(col1(i)) For Each cel1 In col1Range cel1.Value = Int((Max - Min + 1) * Rnd + Min) Next
Next c = c + 1 Loop While Range("f84").Value <> Range("f6").Value
Do
For i = 1 To col2.Count Set col1Range = Range(col2(i)) For Each cel1 In col1Range cel1.Value = Int((Max - Min + 1) * Rnd + Min) Next
Next c = c + 1 Loop While Range("g84").Value <> Range("g6").Value
Do
For i = 1 To col3.Count Set col1Range = Range(col3(i)) For Each cel1 In col1Range cel1.Value = Int((Max - Min + 1) * Rnd + Min) Next
Next c = c + 1 Loop While Range("h84").Value <> Range("h6").Value MsgBox c & "циклов пока подобрало значения" End Sub
[/vba]
Поиск решения по группам с сортировкой дает не тот результат, что необходим: К примеру три строки из группы заполнены просто нулями, а остальные проставлены единицы. А необходимо случайное распределение включающее в себя и двойки. + ограничение на кол-во ячеек в "поиск решения".. + нужно все организовать "нажатием одной кнопки" =\SkyPro
skypro1111@gmail.com
Сообщение отредактировал SkyPro - Среда, 03.07.2013, 16:45
SkyPro, нужно получить одно решение или таких решений нужно несколько? Если одно, то вот. "ИСТИНА" по строкам получил с пом-ю ertert (см. Module3), а в столбцах вручную переместил несколько цифр (если хорошо подумать, то, наверное, столбцы тоже можно автоматизировать). Скорее всего, нужен какой-нибудь кудрявый алгоритм (и наверняка он есть!); случайные числа - это как-то зыбко.
SkyPro, нужно получить одно решение или таких решений нужно несколько? Если одно, то вот. "ИСТИНА" по строкам получил с пом-ю ertert (см. Module3), а в столбцах вручную переместил несколько цифр (если хорошо подумать, то, наверное, столбцы тоже можно автоматизировать). Скорее всего, нужен какой-нибудь кудрявый алгоритм (и наверняка он есть!); случайные числа - это как-то зыбко.nilem
Nilem, спасибо огромное за помощь. Нужно получить решение, удовлетворяющее все условия. Данные будут меняться (не единоразовое решение).
ЗЫ: Могу я попросить вас как-нибудь откомментировать код? А то для меня он не совсем понятен.. =\ Может с вашей помощью разберусь и "додумаю" решение.
Nilem, спасибо огромное за помощь. Нужно получить решение, удовлетворяющее все условия. Данные будут меняться (не единоразовое решение).
ЗЫ: Могу я попросить вас как-нибудь откомментировать код? А то для меня он не совсем понятен.. =\ Может с вашей помощью разберусь и "додумаю" решение.SkyPro
Попробую... Сначала определяем массивы v - это массив сумм по строкам prV и prG - массивы для проверки "SV&CO" и "KK" Определяем массив x&(1 To 74, 1 To 9) ("&" это "As Long") и заполняем его в цикле: если выполняется prV(i) = "SV&CO" And prG(j) = "KK", то пишем 0, если нет, то 0, 1 или 2 заворачиваем это в Do Loop , пока сумма не равна сумме из массива v - While sm <> v(i) И все
Попробую... Сначала определяем массивы v - это массив сумм по строкам prV и prG - массивы для проверки "SV&CO" и "KK" Определяем массив x&(1 To 74, 1 To 9) ("&" это "As Long") и заполняем его в цикле: если выполняется prV(i) = "SV&CO" And prG(j) = "KK", то пишем 0, если нет, то 0, 1 или 2 заворачиваем это в Do Loop , пока сумма не равна сумме из массива v - While sm <> v(i) И все nilem
ЗЫ: Может попытаться прикрутить постепенное уменьшение диапазона столбцов при выполнении условий + соответствующее уменьшение суммы условий? Можно ли для таких целей использовать ReDim?
Спасибо за разьяснение и за помощь.
ЗЫ: Может попытаться прикрутить постепенное уменьшение диапазона столбцов при выполнении условий + соответствующее уменьшение суммы условий? Можно ли для таких целей использовать ReDim?SkyPro
skypro1111@gmail.com
Сообщение отредактировал SkyPro - Пятница, 05.07.2013, 09:58
Мне это реально надо ) И конечная цель именно распределять эти 0, 1 и 2 в диапазоне по условиям. Может тут и есть другие варианты рещения, но нужна кнопка "сделать как надо" =\
Мне это реально надо ) И конечная цель именно распределять эти 0, 1 и 2 в диапазоне по условиям. Может тут и есть другие варианты рещения, но нужна кнопка "сделать как надо" =\SkyPro
Вот смотрите, что получилось. Вариант сырой, допилите сами. сначала нажимаем кнопку "Строки", чтобы поучить ИСТИНА по строкам, потом "Столбцы", чтобы получить столбцы. Там, где "g" (на пересечении "SV&CO" и "KK") - это чтобы отличить от цифр, можно просто Найти-Заменить. Код корявенький, особенно rtyrty (ertert почему-то всегда лучше получается :)), на случайных числах, но вроде работает.
только сейчас обратил внимание: иногда -1 появляется... но если несколько раз перещелкать кнопки Строки-Столбцы, то можно получить рез-т бех отрицательных значений. Проверял с такой формулой:
Код
=СЧЁТЕСЛИ(F9:N82;"<0")
видимо обе процедуры нужно объединить и поместить в еще один цикл.
Вот смотрите, что получилось. Вариант сырой, допилите сами. сначала нажимаем кнопку "Строки", чтобы поучить ИСТИНА по строкам, потом "Столбцы", чтобы получить столбцы. Там, где "g" (на пересечении "SV&CO" и "KK") - это чтобы отличить от цифр, можно просто Найти-Заменить. Код корявенький, особенно rtyrty (ertert почему-то всегда лучше получается :)), на случайных числах, но вроде работает.
только сейчас обратил внимание: иногда -1 появляется... но если несколько раз перещелкать кнопки Строки-Столбцы, то можно получить рез-т бех отрицательных значений. Проверял с такой формулой:
Код
=СЧЁТЕСЛИ(F9:N82;"<0")
видимо обе процедуры нужно объединить и поместить в еще один цикл.nilem