Сочетания без повторений из разных числовых комбинаций

RSS

Сочетания без повторений из разных числовых комбинаций, Нужно из определённой комбинации с различным числом чисел извлечь максимальное число сочетаний без повторений

Cristal

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

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

27.02.2022 02:32:10

Здравствуйте Уважаемые Форумчане!
Нужна Ваша помощь, если можно и возможно, то это здорово.
У меня Excel 2007.
Нужен макрос Excel.
Тема: Сочетания без повторений из разных числовых комбинаций

Об этом написано на сайте:
https://www.matburo.ru/tvart_sub.php?p=calc_C

Нужно из определённой комбинации с различным числом чисел извлечь максимальное
число сочетаний без повторений.
Например, данна какая-то комбинация из 6(7-8-9-10 и т.д) чисел:
6 16 33 43 45 49
и я хочу применить(извлечь) максимальное число сочетаний без повторений
То есть я использую по желанию формулу: 5 из 6 а это значит, что повторений будет
максимально только 6, это зависит от комбинации.
Количество чисел в комбинации могут быть различны и подбор может быть тоже разным.
Например, комбинация из 6 чисел- 6 16 33 43 45 49 я могу применить 5 из 6, 4 из 6, 3 из 6 или 2 из 6.
То есть найти сочетания из n по k.
Комбинаций может быть большое количество.

Большое Вам всем спасибо!!!
Прилагаю пример

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

Пример.xlsx (12.25 КБ)

MCH

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

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

27.02.2022 07:39:45

Для перебора сочетания посмотрите реализацию здесь: http://www.excelworld.ru/forum/3-36449-1
Если не получится адаптировать к своей задаче - сообщите, можно будет применить макрос к текущей задаче
Также можно сделать перебор 2^n комбинаций, что также будет полным аналогом, но в другой последовательности
А лучше сообщите, какая конечная цель данного перебора, что будете дальше с ним делать?

MCH Пользователь Сообщений: 3906 Регистрация: 22.12.2012	#3 27.02.2022 08:28:30 генерация сочетаний 5 из 6, 4 из 6, 3 из 6, 2 из 6, 1 из 6 Прикрепленные файлы сочетания.xlsm (18.14 КБ)

Cristal Пользователь Сообщений: 109 Регистрация: 15.05.2021	#4 27.02.2022 10:52:30 ,Большое Вам спасибо, хорошо получилось!!!

Ігор Гончаренко

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

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

27.02.2022 11:14:25

Код

Sub CalckC()
  Dim a, b, i&, r&
  r = 5: a = Split(Cells(r, 1)): Columns(2).ClearContents
  For i = UBound(a) To 2 Step -1
    b = CombinationsFromArray2M(a, i)
    Cells(r, 2).Resize(UBound(b), 1) = WorksheetFunction.Transpose(b)
    r = r + UBound(b) + 1
  Next
End Sub

Function CombinationsFromArray2M(a, m As Long, Optional Sep$ = " ")
  Dim p&(), r(), i&, j&, N&, di&, c&
  di = 1 - LBound(a): N = UBound(a) + di
  With WorksheetFunction: i = .Fact(N) / .Fact(m) / .Fact(N - m): End With
  If Sep = "" Then ReDim r(1 To i, 1 To m) Else ReDim r(1 To i)
  ReDim p(1 To m): For i = 1 To m: p(i) = i: Next: p(m) = p(m - 1)
  Do
    If p(m) < N Then
      p(m) = p(m) + 1
    Else
      For i = m - 1 To 1 Step -1: If p(i) < N - m + i Then Exit For
      Next
      p(i) = p(i) + 1: For i = i + 1 To m: p(i) = p(i - 1) + 1: Next
    End If
    c = c + 1
    If Sep = "" Then
      For i = 1 To m: r(c, i) = a(p(i) - di): Next
    Else
      r(c) = a(p(1) - di): For i = 2 To m: r(c) = r(c) & Sep & a(p(i) - di): Next
    End If
    If c = UBound(r) Then Exit Do
  Loop
  CombinationsFromArray2M = r
End Function

выполните CalckC. если в А5 будет немного больше чисел - тоже сработает)

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

Cristal Пользователь Сообщений: 109 Регистрация: 15.05.2021	#6 27.02.2022 13:41:22 , Игорь, большое Вам спасибо, Уважение и низкий поклон Вашему таланту. Как всегда, Вы на высоте! Вы сделали макрос с большим выбором чисел в комбинации! Это здорово!

Ігор Гончаренко Пользователь Сообщений: 14576 Регистрация: 01.01.1970	#7 27.02.2022 13:57:07 да ладно... перебирать данные в массиве - это не высота, это задача для ремесленника от программирования, понимающего азы VBA если чисел в А5 будет много - макрос упадет по ошибке из-за выхода за размеры страницы грань между "много" и "не много" вы можете установить эмпирическим путем или посчитать (я обломился считать еще и это) Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!