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

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

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 21.02.2020, 11:28   #1
helika
Новичок
Джуниор
 
Регистрация: 21.02.2020
Сообщений: 3
По умолчанию Подбор вариантов комбинаций цифр по имеющейся сумме

]Добрый день!
Не могу понять...необходимо из 4-х чисел получить различные комбинации, сумма которых не будет превышать 1230.
Комбинации должны быть все возможные, а у меня получается только, что каждое число используется только один раз и не повторяется..
Помогите, пожалуйста. Если не сложно, то поправьте в файле, а то я так себе пользователь excel.
Код:
Sub SHpetsBrute()
Dim MVal ' массив для переноса чисел с листа
Dim CVal As Integer 'кол-во чисел
Dim Komb As Long 'кол-во всех комбинаций
Dim i As Long 'счётчик комбинаций
Dim j As Integer 'счетчик перебираемых чисел
Dim m As Long 'текущая комбинация
Dim tmp As String 'строка для вывода на лист
Dim s As Double 'текущая сумм комбинации
Dim nS As Double 'нужная сумма комбинации
Dim dopusk As Double 'допуск отклонения найденой суммы от нужной
Dim nex As Long 'счётчик строк
Dim t As Single 'счётчик времени

'-------------------------------------------------------------
  If Not TypeName(Selection) = "Range" Then Exit Sub 'СТОП, если выделен не диапазон
  If Selection.Columns.Count > 1 Then
    MsgBox "Числа должны располагаться вертикально!", 4, "Ошибка!"
    Exit Sub
  ElseIf Selection.Count <= 4 Then
    MVal = Application.Transpose(Selection) 'переносим числа в массив VBA
    CVal = UBound(MVal) 'и сколько же их?
  Else
    MsgBox "Количество чисел не должно превышать 4!", 4
  End If
  nS = InputBox("Введите нужную сумму для поиска", , 200)
  dopusk = InputBox("Введите допустимое отклонение +/-", , 1)
'-----------------------------------------------------------------------------------
  t = Timer 'запоминаем текущее время
  'Application.ScreenUpdating = False 'обновление экрана: выкл.
  Komb = 2 ^ CVal - 1 'определяем кол-во комбинаций
  For i = 1 To Komb 'перелистываем комбинации
    m = i 'работаем с копией
    tmp = "": s = 0 'очищаем переменные
    For j = 1 To CVal
        If m Mod 2 Then tmp = tmp & IIf(tmp = "", "'=", "+") & MVal(j): s = s + MVal(j)
        m = m \ 2: If m = 0 Then Exit For
    Next j
    If Abs(s - nS) <= dopusk + 0.000001 Then
        ActiveCell.Offset(nex, 2) = s: ActiveCell.Offset(nex, 1) = tmp 'выводим на лист
        nex = nex + 1 'номер следующей строки
    End If
  Next i
  'Application.ScreenUpdating = True 'обновление экрана: вкл.
  MsgBox ("потребовалось " & Format(Timer - t, "0.000") & " сек.")
  If nex = 0 Then MsgBox ("Нужная сумма не найдена")
  
End Sub
helika вне форума Ответить с цитированием
Старый 21.02.2020, 11:59   #2
evg_m
Старожил
 
Регистрация: 20.04.2008
Сообщений: 5,515
По умолчанию

Цитата:
Комбинации должны быть все возможные, а у меня получается только, что каждое число используется только один раз и не повторяется..
используется ровно один раз за ВСЕ комбинации ?
в любой из получаемых комбинаций число встречается НЕ более чем один раз?
какой из вариантов ваш ? что получилось у вас.

Цитата:
в любой из получаемых комбинаций число встречается НЕ более чем один раз?
обычно комбинации так и определяются.
числа берутся из предложенного списка и НЕ более одного раза каждое из них.
хотите больше вносите число в список второй(третий...) разы.
программа — запись алгоритма на языке понятном транслятору
evg_m вне форума Ответить с цитированием
Старый 21.02.2020, 12:12   #3
helika
Новичок
Джуниор
 
Регистрация: 21.02.2020
Сообщений: 3
По умолчанию

evg_m, несколько раз тоже прописывала, но тогда появляется множество одинаковых комбинаций....
helika вне форума Ответить с цитированием
Старый 21.02.2020, 12:46   #4
helika
Новичок
Джуниор
 
Регистрация: 21.02.2020
Сообщений: 3
По умолчанию

evg_m, вот, что получается у меня.
миллион переборок с одинаковым значением...)
Вложения
Тип файла: xls Таблица1 (3).xls (221.0 Кб, 1 просмотров)
helika вне форума Ответить с цитированием
Старый 21.02.2020, 12:47   #5
evg_m
Старожил
 
Регистрация: 20.04.2008
Сообщений: 5,515
По умолчанию

т. е. вы хотите
дан список 2, 2, 3, 5
получить полный список комбинаций из трех чисел.
2 2 3
2 2 5
2 3 5
2 3 5 и чтобы ВОТ такой комбинации "второй" раз не было.
в "теории" комбинаций такая строка считается отличной от другой такой и имеет право присутствовать в перечне.
хотите убрать?
самый простой вариант (по написанию) это составить полный перечень(с повторами)
а потом убрать из него лишнее.
придумать алгоритм генерации сразу без повторов конечно наверное тоже возможно, но это дело не пяти секунд (даже для меня и др.)

P.S. мысль вслух
нам надо как-то объяснить программе
что (применительно к моему примеру) комбинации 01xx и 10xx (вторая и первая двойки соответственно в одном экземпляре(т.е. без другой)) являются одинаковыми и поэтому комбинация 10xx должна быть пропущена.
т.е. нам сначала нам надо будет составлять список повторных комбинаций (на основе анализа исходного списка чисел)
затем при генерации "пропускать" повторные.
программа — запись алгоритма на языке понятном транслятору

Последний раз редактировалось evg_m; 21.02.2020 в 12:57.
evg_m вне форума Ответить с цитированием
Ответ


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

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Составление всевозможных комбинаций из цифр nnkorol Помощь студентам 12 07.07.2015 15:39
Вывести на экран все двухзначные числа которые равны сумме своих цифр и сумме в квадрате/Turbo Pascal Pavel2502 Помощь студентам 5 26.02.2014 22:18
Задача на подбор чисел и выведения кол-ва вариантов hruma Помощь студентам 5 29.11.2013 15:13
Решить задачу в Паскале подбор вариантов veryfreshman Помощь студентам 0 13.11.2011 15:13
сортировка данных (пересчет возможных вариантов комбинаций, перенос данных в таблицу) Vitalik85 Microsoft Office Excel 4 12.08.2009 00:30