Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 19.02.2016, 23:44   #1
KotKod
Новичок
Джуниор
 
Аватар для KotKod
 
Регистрация: 19.02.2016
Сообщений: 2
Вопрос Перебор вариаций в двомерном масиве

Есть двомерний массив
Пример:

Нужно сделать список такого рода(перебрать все вариации но не смешивать колонки):

A one yes
A one no
A two yes
A two no
A Three yes
A Three no
B one yes
B one no
B two yes
B two no
B Three yes
B Three no
C one yes
C one no
C two yes
C two no
C Three yes
C Three no
D one yes
D one no
D two yes
D two no
D Three yes
D Three no

Сделать цикл в цикле не могу так как количество элементов на каждом уровне массива может меняться.
KotKod вне форума Ответить с цитированием
Старый 20.02.2016, 01:57   #2
IgorGO
Новичок
СтарожилДжуниор
 
Аватар для IgorGO
 
Регистрация: 05.02.2008
Сообщений: 9,487
По умолчанию

если сначала проанализировать сколько значений в строке, то можно и цикл в цикле.
1. внесите данные в произвольный диапазон на листе
2. количество строк с данными - не ограничено
3. количество данных в каждой строке не ограничено, произвольно но не МЕНЕЕ 1 шт.
4. ЕЩЕ ОДНО ПРАВИЛО подготовки данных: все данные в строке должны быть "прижаты" к левой стороне диапазона!!!
5. Скопируйте в модуль листа этот
Код:
Sub Combine()
  Dim arr, p() As Long, up() As Long, res(), r As Long, c As Long, cnt As Long, L As Long, i As Long, j As Long, rg As Range
  Set rg = Application.InputBox("Отметьте мышью", "Укажите диапазон с данными", Type:=8)
  If rg Is Nothing Then Exit Sub Else arr = rg.Value:  L = 1
  ReDim p(0 To UBound(arr)) As Long
  ReDim up(0 To UBound(arr)) As Long
  For r = 1 To UBound(arr)
    p(r) = 1
    For c = 1 To UBound(arr, 2)
      If IsEmpty(arr(r, c)) Then Exit For Else up(r) = up(r) + 1
    Next
    L = L * up(r)
  Next
  ReDim res(1 To L, 1 To UBound(arr))
  r = 0:  p(UBound(arr)) = 0
  Do
    i = UBound(arr)
    Do While p(i) = up(i):  i = i - 1:  Loop
    p(i) = p(i) + 1:  r = r + 1
    If i < UBound(arr) Then
      For j = i + 1 To UBound(arr):  p(j) = 1:  Next
    End If
    For c = 1 To UBound(arr)
      res(r, c) = arr(c, p(c))
    Next
  Loop Until r = L
  Set rg = Application.InputBox("Ткните мышью в ячейку", "Куда выложить результаты?", Type:=8)
  If rg Is Nothing Then Set rg = Cells(ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count, 1)
  rg.Resize(L, UBound(arr)).Value = res
End Sub
6. Выполните макрос любым доступным способом
7. Макрос спросит где находятся данные и куда сложить результаты

удачи!
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете

Последний раз редактировалось IgorGO; 20.02.2016 в 02:00.
IgorGO вне форума Ответить с цитированием
Старый 20.02.2016, 04:39   #3
KotKod
Новичок
Джуниор
 
Аватар для KotKod
 
Регистрация: 19.02.2016
Сообщений: 2
Радость

Цитата:
Сообщение от IgorGO Посмотреть сообщение
удачи!
Спасибо, все работает =) инфа есть как єто реализовывается.
KotKod вне форума Ответить с цитированием
Старый 20.02.2016, 09:33   #4
IgorGO
Новичок
СтарожилДжуниор
 
Аватар для IgorGO
 
Регистрация: 05.02.2008
Сообщений: 9,487
По умолчанию

правильно это оформить так:
Код:
Sub Start()
  Dim arr, rg As Range
  Set rg = Application.InputBox("Отметьте мышью", "Укажите диапазон с данными", Type:=8)
  If rg Is Nothing Then Exit Sub Else arr = rg.Value:  arr = Combine(arr)
  Set rg = Application.InputBox("Ткните мышью в ячейку", "Куда выложить результаты?", Type:=8)
  If Not rg Is Nothing Then rg.Resize(UBound(arr), UBound(arr, 2)).Value = arr
End Sub


'******************************************************************************
' на входе массив данных MxN, на выходе массив всех ВОЗМОЖНЫХ КОМБИНВЦИЙ ZxM,
' которые содержат по 1-му элементу из каждой строки
' Z = произв.количества элементов в строках (в строках произвольное кол-во элементов)
'
Function Combine(arr)
  Dim p() As Long, up() As Long, res(), r As Long, c As Long, cnt As Long, L As Long, i As Long, j As Long, rg As Range
  L = 1
  ReDim p(0 To UBound(arr)) As Long
  ReDim up(0 To UBound(arr)) As Long
  For r = 1 To UBound(arr)
    p(r) = 1
    For c = 1 To UBound(arr, 2)
      If IsEmpty(arr(r, c)) Then Exit For Else up(r) = up(r) + 1
    Next
    L = L * up(r)
  Next
  ReDim res(1 To L, 1 To UBound(arr))
  r = 0:  p(UBound(arr)) = 0
  Do
    i = UBound(arr)
    Do While p(i) = up(i):  i = i - 1:  Loop
    p(i) = p(i) + 1:  r = r + 1
    If i < UBound(arr) Then
      For j = i + 1 To UBound(arr):  p(j) = 1:  Next
    End If
    For c = 1 To UBound(arr)
      res(r, c) = arr(c, p(c))
    Next
  Loop Until r = L
  Combine = res
End Function
Выполните Start, а функцию Combine смело перемещайте в библиотеку функций по КОМБИНАТОРИКЕ
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете
IgorGO вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Программа перебора вариантов (изменить перебор цифровой на перебор буквенный) BArt2000 Паскаль, Turbo Pascal, PascalABC.NET 5 02.03.2015 12:56
поиск в масиве Apis Общие вопросы C/C++ 2 12.09.2011 05:51
Инверсия в масиве user10 Паскаль, Turbo Pascal, PascalABC.NET 2 18.04.2011 00:19
поиск в масиве Apis Паскаль, Turbo Pascal, PascalABC.NET 1 25.04.2010 23:36
ПОВТОР ЗНАЧЕНИЯ В МАСИВЕ Slavik Microsoft Office Excel 11 27.01.2009 08:13