Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Перебор возможных комбинаций
 
#1
24.01.2016 21:34:34
Как сделать перебор и вывод всех возможных комбинаций на основе имеющихся символов? Количество символов 4 (u,d,l,r)

Например:
Скрытый текст

Мне необходим только список этих значений? Подскажите, как это сделать.
 
 
 
#2
24.01.2016 21:36:52
Макросом
Согласие есть продукт при полном непротивлении сторон
 
 
 
#3
24.01.2016 21:49:36
А можно чуть поподробнее, я в этом не силен?
 
 
 
#4
24.01.2016 21:55:05
Подробнее
 
 
 
#5
24.01.2016 21:57:21
Сообщение #4
Согласие есть продукт при полном непротивлении сторон
 
 
 
#6
24.01.2016 22:28:55
объясню, почему я создал новую тему. Знаю, ято данная темя поднималась не раз, но у меня не много другая задача.

рассмотрим пример 4 символа, 2 элемента. Те решения которые я нашел дают такой ответ.
Скрытый текст

Мне необходимо получить такой список:
Скрытый текст
 
 
 
#7
24.01.2016 22:45:14
Так?
 
 
 
#8
24.01.2016 22:52:45
Спасибо большое!!!
 
 
 
#9
24.01.2016 23:02:17
Если не трудно сделайте пожалуйста пример с 5 символами (u,d,l,r,f). кол-во элементов 3, 4, 5
 
 
 
#10
24.01.2016 23:23:51
Посмотрите код и дальше сами по аналогии ))
 
 
 
#11
24.01.2016 23:26:58
огромное спасибо!!!
 
 
 
#12
24.01.2016 23:32:10
Вот ))
 
 
 
#13
24.01.2016 23:38:02
Не знаю как Вас благодарить! СПАСИБО!!!
 
 
 
#14
25.01.2016 00:28:19
Цитата
lorents написал: Не знаю как Вас благодарить!
Вот проблема.  :)
Стоит только взглянуть в его грустные глаза, и на остатки его рыбки...
 
 
 
#15
25.01.2016 00:30:09
:D
 
 
 
#16
18.06.2016 00:51:15
добрый вечер!
Подскажите, пожалуйста. Если возьмем вышеприведенную задачу и чуть усложним,

После запуска файла U-D-L-R-F (02).xlsm ,он создает список
Скрытый текст

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

Буду признателен за ответы
Изменено: lorents - 18.06.2016 20:00:24
 
 
 
#17
18.06.2016 12:54:01
См. файл.
 
 
 
#18
18.06.2016 20:01:03
Спасибо большое!!!
А можно ли это же сделать ко всем столбцам?
Изменено: lorents - 18.06.2016 20:01:35
 
 
 
#19
18.06.2016 20:01:39
Цитата
lorents написал:
А можно это приметь столбцам?
???
 
 
 
#20
18.06.2016 20:02:46
Исправил выше, имел ввиду, сделать все столбцы без дубликатов.
 
 
 
#21
18.06.2016 20:05:20
Вы показали, что нужен один столбец - для одного и сделал.
У Вас теперь есть два варианта кода: сравните их и увидите, где добавлен блок преобразования столбца. Попробуйте применить к оставшимся. Что будет не получаться - спрашивайте.
 
 
 
#22
18.06.2016 20:21:23
Спасибо, буду разбираться! мне нужно разобраться только с четвертым столбцом. пятый не нужен.
 
 
 
#23
18.06.2016 20:35:51
Получилось:
Код
Sub Macro1()
Dim i As Long, j As Long, m As Long, n As Long, k As Long, x As Long, Arr()
Dim sLetter As String, Counter As Long
    Arr = Range(Cells(1, 1), Cells(5, 1)).Value
    ReDim Arr2(1 To 25, 1 To 1)
    For i = 1 To 5
        For j = 1 To 5
            x = x + 1
            Arr2(x, 1) = Arr(i, 1) & Arr(j, 1)
        Next
    Next
    k = 0
    ReDim Arr3(1 To UBound(Arr2), 1 To 1)
    For i = 1 To UBound(Arr2)
        Counter = 0
        For j = 1 To Len(Arr2(i, 1))
            sLetter = Mid(Arr2(i, 1), j, 1)
            If InStr(j + 1, Arr2(i, 1), sLetter, 1) > 0 Then
                Counter = Counter + 1
                Exit For
            End If
        Next
        If Counter = 0 Then
            k = k + 1
            Arr3(k, 1) = Arr2(i, 1)
        End If
    Next
    Cells(1, 2).Resize(k, 1).Value = Arr3
    x = 0
    ReDim Arr2(1 To 125, 1 To 1)
    For i = 1 To 5
        For j = 1 To 5
            For m = 1 To 5
                x = x + 1
                Arr2(x, 1) = Arr(i, 1) & Arr(j, 1) & Arr(m, 1)
            Next
        Next
    Next
    k = 0
    ReDim Arr3(1 To UBound(Arr2), 1 To 1)
    For i = 1 To UBound(Arr2)
        Counter = 0
        For j = 1 To Len(Arr2(i, 1))
            sLetter = Mid(Arr2(i, 1), j, 1)
            If InStr(j + 1, Arr2(i, 1), sLetter, 1) > 0 Then
                Counter = Counter + 1
                Exit For
            End If
        Next
        If Counter = 0 Then
            k = k + 1
            Arr3(k, 1) = Arr2(i, 1)
        End If
    Next
    Cells(1, 3).Resize(k, 1).Value = Arr3
    Erase Arr2
    Erase Arr3
    x = 0
    ReDim Arr2(1 To 625, 1 To 1)
    For i = 1 To 5
        For j = 1 To 5
            For m = 1 To 5
                For n = 1 To 5
                    x = x + 1
                    Arr2(x, 1) = Arr(i, 1) & Arr(j, 1) & Arr(m, 1) & Arr(n, 1)
                Next
            Next
        Next
    Next
    k = 0
    ReDim Arr3(1 To UBound(Arr2), 1 To 1)
    For i = 1 To UBound(Arr2)
        Counter = 0
        For j = 1 To Len(Arr2(i, 1))
            sLetter = Mid(Arr2(i, 1), j, 1)
            If InStr(j + 1, Arr2(i, 1), sLetter, 1) > 0 Then
                Counter = Counter + 1
                Exit For
            End If
        Next
        If Counter = 0 Then
            k = k + 1
            Arr3(k, 1) = Arr2(i, 1)
        End If
    Next
    Cells(1, 4).Resize(k, 1).Value = Arr3
End Sub
Изменено: lorents - 18.06.2016 20:38:34
 
 
 
#24
18.06.2016 20:37:13
Ну вот! ))
 
 
 
#25
18.06.2016 20:38:50
Спасибо Вам Большое!!!!
 
 
 
Страницы: 1
Наверх