Страницы: 1
RSS
Перекрёстный рандом из коллекции уникальных?
 
Здравствуйте.Уважаемые сверхзнатоки vba,не первый год пишу для себя макросы,но на этот раз вошёл в ступор.Не получается сгенерировать рандом уникальных в коллекции,что-бы были в столбце и в строке уникальные из коллекции без повторений и без пустых ячеек,как в примере.Перепробовал много вариантов и безрезультатно,этот код оставляет тоже пустые ячейки.

Sub Проверка11()
      Application.ScreenUpdating = False
Dim j&, i&, a&, b&, c&, m&, d&, v&, arr(), r As New Collection
arr = [a1:d4].Value
b = 1:  a = 1:
For c = 1 To 4
r.Add 99
r.Add 88
r.Add 77
r.Add 66
    Randomize
 For i = 1 To 4
j = CInt((4 - i) * Rnd + 1)
t = r.Item(j)
If arr(a + d, b + m) = Empty Then
For v = 1 To 4
If arr(a + k, b + m) = t Then
m = m + 1
k = 0
Exit For
Else
k = k + 1
 End If
Next v
If k = 4 Then arr(a + d, b + m) = t: k = 0: m = m + 1
Else
m = m + 1
If m = 4 Then m = 0
End If
If m = 4 Then m = 0
r.Remove (j)
Next i
d = d + 1
m = 0
Next c
[a1:d4].Value = arr
Application.ScreenUpdating = True
End Sub
 
Формат .xlsx не предполагает наличие макросов. Т.к. ваш вопрос по макросу, то желательно прикладывать файл с макросом, а не отдельно файл и макрос.

зы. у меня ваш макрос не работает - не все переменные объявлены, а выяснять какие для чего - нет желания.
Изменено: Михаил С. - 04.03.2013 18:37:07
 
Странно,у меня макрос работает.Да впрочем разберусь сам.   :)
 
Скорее всего, если бы файл был выложен вместе с макросом, у меня он бы тоже работал. А так, у меня Option Explicit, а у вас не все переменные объявлены. Да и лишнюю работу заставляете делать: копировать и вставлять макрос...
Да и конечная цель не совсем понятна...
 
Добрый вечер.Объявил все переменные и скопировал в книгу .Макрос работает,но с погрешностями ,оставляет пустые ячейки.Нужно ,что-бы в укзанном диапазоне ,каждое из четырёх чисел  из коллекции обязательно повторялось один раз в каждом столбце и в каждой строке диапазона(в рандомном порядке=не одинаковые диапазоны между собой).Пример,это упрощённый вариант ,на самом деле у меня диапазон во много раз больше и этих диапазонов тысячи.
 
Извините вот книга с эти кодом.
 
Как вижу решение я:
1. Ищем в интернете "алгоритм заполнения магического квадрата"
2. Реализуем алгоритм кодом на VBA
3. Возможно, для создания эффекта "случайного разброса цифр" переставляем рандомно строки
Учимся сами и помогаем другим...
 
Магического квадрат,это сумма(меня это не интересует),да и при разбросе строк,очень часто не будет соответствовать условию по столбцам(написанному выше).Да , это наверное высший пилотаж для vba,вот почему я не смог это быстро сделать и это немного утешает. :)
 
сумма это следствие того, что один и тот же набор чисел раскидан уникально по строкам и столбцам. Поэтому магический квадрат как раз то, что нужно. Это видно даже по Вашему примеру.
Разброс строк так же ничего не поменяет в части условия по столбцам, т.к. это всего лишь будет перестановка элементов столбца.
Учимся сами и помогаем другим...
 
Да,что касается только по строкам или только по столбцам можно отталкиваться от суммы, но  я это могу сделать и без этого.Но,что касается  и по столбцам и сткрокам вместе ,я не согласен,к примеру:если в строке сумма равна (нужной), а в столбце уже была сумма не равна нужной  ,перестановка строк ничего не изменит.От перестановки мест слагаемых сумма меняется.
Я нашёл выход,просто кое,что изменил в подходе.
Тема закрыта.
Страницы: 1
Читают тему
Наверх