Рандомный генератор значений

RSS

Рандомный генератор значений, случайный выбор значений из масива из 3-4-5-6 и более ячеек сцепить их и главное их постоянная уникальность

Dongpo

Пользователь

Сообщений: 16 Регистрация: 13.12.2016

01.03.2017 12:57:04

Помогите пожалуйста написать макрос либо же формулой если это возможно.
Есть масив данных.
Нужно в рандомном порядке сцепить значения из ячеек и вывести их в отдельный столбец/лист

Слово	буква	алгоритм	пароль
Клей	масло	сахар	машина
хлкеб	пуля	планета	кукла

Например должно получится

Слово+буква+алгоритм+пароль (это лекго с формулой сцепить)
Слово+хлеб+сахар+буква (это как комбинации в пароле но из слов)

Нужно вывести все возможные комбинации сочетаний слов

Dongpo

Пользователь

Сообщений: 16 Регистрация: 13.12.2016

01.03.2017 13:24:15

Вот есть такой макрос, но он не решает вопрс полностью.
Что бы решить его нужно еще много ручками поработать.

Код

Sub www()
    Dim i&, j&, n&, data
    data = Range("A1", Range("A1").End(xlDown)).Value
    n = UBound(data)
    ReDim out(1 To n ^ 3, 1 To 1)
    
    For i = 1 To n ^ 3
        For j = 0 To 2
            out(i, 1) = out(i, 1) & IIf(j = 0, "", " ") & Split(data((i - 1) \ n ^ (2 - j) Mod n + 1, 1) & "  ")(j)
    Next j, i
    Columns("B:B").ClearContents
    Range("B1").Resize(n ^ 3, 1) = out
End Sub

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

Прикрепленные файлы

МАКРОС.xlsm (17.03 КБ)

Изменено: Dongpo - 01.03.2017 13:35:15

Sanja

Модератор

Сообщений: 16505 Регистрация: 10.01.2013

01.03.2017 17:02:41

Вариант. Не уверен, что ВСЕ возможные комбинации, но случайные и уникальные точно

Код

Option Explicit
Sub RndMergeUn()
Dim arrVal, dicVal, varTemp
Dim i&, j&, k&
arrVal = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).Value
Set dicVal = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(arrVal)
    For j = 0 To UBound(Split(Trim(arrVal(i, 1))))
        varTemp = dicVal.Item(Split(Trim(arrVal(i, 1)))(j))
    Next
Next
Randomize
On Error Resume Next
With CreateObject("Scripting.Dictionary")
    For i = 0 To UBound(dicVal.Keys)
        For j = 0 To UBound(dicVal.Keys)
            For k = 0 To UBound(dicVal.Keys)
                i = Int((UBound(dicVal.Items()) * Rnd) + 1)
                j = Int((UBound(dicVal.Items()) * Rnd) + 1)
                k = Int((UBound(dicVal.Items()) * Rnd) + 1)
                varTemp = .Item(Join(Array(dicVal.Keys()(i), dicVal.Keys()(j), dicVal.Keys()(k))))
            Next
        Next
    Next
    Range("C1").Resize(.Count) = Application.Transpose(.Keys)
End With
End Sub

Согласие есть продукт при полном непротивлении сторон

Dongpo Пользователь Сообщений: 16 Регистрация: 13.12.2016	#4 01.03.2017 20:07:12 Sanja, большое спасибо. Хороший вариант решения проблемы. Но как Вы и сказали не все варианты. Всего вышло 502 варианта а должно то быть 999. Но мне и этого количества хватит. Сеошники довольны, а значит и я. Благодарю!!!