Нужна Ваша помощь! Помогите пожалуйста, если это возможно! Нужно сделать Подбор к комбинации из 6 чисел неизвестных слагаемых(от 1 до 49) к желаемой сумме в случае, если известны в комбинации из 6 чисел только 3 или 4 или 5 чисел. Нужно использовать все возможные слагаемые(от 1 до 49), чтобы получить желаемую сумму. Ну а если не найдутся не известные слагаемые к желаемой сумме, то тогда буду к комбинации из 6 чисел с известными слагаемыми(3 или 4 или 5 числами) выбирать другую желаемую сумму.
Известные слагаемые в комбинации из 6 чисел при этом не меняются. У меня Эксцель-2007! Нужен Эксцель-макрос и кнопка в верхнем правом углу. Спасибо Вам большое! Постарался пошагово объяснить! Всё остальное в файле-примере Эксцель!
New: кровь из глаз идёт, когда вы программу Excel (в русском произношении "Эксел(ь)", в английском "Иксел" ([ɪkˈsel])) называете "Эксцель"
если про кровь именно из ГЛАЗ, то лично меня "иксэл" ранит куда больше, чем "Эксцэль", в котором, по сути одна буква только лишняя В фонетическом же смысле эта "ц" вообще игнорируется и в итоге слово звучит вполне себе нормально
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Option Explicit
Sub Спортлото()
Dim arr As Variant
arr = GetArr(Range("A1:G1"))
Range("B2").Resize(UBound(arr, 1), UBound(arr, 2)) = arr
End Sub
Function GetArr(r As Range) As Variant
Dim s As Long
s = r.Cells(1, 1).Value
Dim arr As Variant
arr = r.Range("B1:G1")
Dim x As Long
Dim y As Long
y = 1
For x = UBound(arr, 2) To 1 Step -1
If arr(1, x) = "" Then
y = y * 49
End If
Next
Dim brr As Variant
If y > Rows.Count - 2 Then y = Rows.Count - 2
ReDim brr(1 To y, 1 To 6)
If y > 1 Then
Dim i1 As Byte
Dim i2 As Byte
Dim i3 As Byte
Dim i4 As Byte
Dim i5 As Byte
Dim i6 As Byte
y = 0
For i1 = IIf(arr(1, 1) = "", 1, arr(1, 1)) To IIf(arr(1, 1) = "", 49, arr(1, 1))
For i2 = IIf(arr(1, 2) = "", 1, arr(1, 2)) To IIf(arr(1, 2) = "", 49, arr(1, 2))
For i3 = IIf(arr(1, 3) = "", 1, arr(1, 3)) To IIf(arr(1, 3) = "", 49, arr(1, 3))
For i4 = IIf(arr(1, 4) = "", 1, arr(1, 4)) To IIf(arr(1, 4) = "", 49, arr(1, 4))
For i5 = IIf(arr(1, 5) = "", 1, arr(1, 5)) To IIf(arr(1, 5) = "", 49, arr(1, 5))
For i6 = IIf(arr(1, 6) = "", 1, arr(1, 6)) To IIf(arr(1, 6) = "", 49, arr(1, 6))
If s = i1 + i2 + i3 + i4 + i5 + i6 Then
y = y + 1
brr(y, 1) = i1
brr(y, 2) = i2
brr(y, 3) = i3
brr(y, 4) = i4
brr(y, 5) = i5
brr(y, 6) = i6
End If
If y = UBound(brr, 1) Then Exit For
Next
If y = UBound(brr, 1) Then Exit For
Next
If y = UBound(brr, 1) Then Exit For
Next
If y = UBound(brr, 1) Then Exit For
Next
If y = UBound(brr, 1) Then Exit For
Next
If y = UBound(brr, 1) Then Exit For
Next
End If
GetArr = brr
End Function
Cristal посмотрел твою задумку, мне кажется тут очень сложно "взломать" таким способом лотерею, вот из твоего примера Известно 3 числа: 1-2-10 Желаемая сумма 123 Нужно найти все комбинации с неизвестными числами под сумму 123 получается у тебя тут получается сумма всего 13, тебе нужно найти любые три числа от 1 до 49 чтобы в сумме получилось 120, плюс не совсем понятно может ли одно число повторятся дважды?
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
DJMC написал: тут очень сложно "взломать" таким способом лотерею
взломать лотерею, в которой каждый следующий розыгрыш является СЛУЧАЙНЫМ и НИКАК НЕ ЗАВИСИТ ОТ ВСЕХ ПРЕДЫДУЩИХ - не возможно спросите у любого что хоть самую малость понимает в азах математики понимаете? вероятность того что в след. розыгрыше выпадет 1,2,3,4,5,6 точно такая же как вероятность выпасти ЛЮБЫМ другим 6 числам, ЛЮБЫМ! даже тем 6-и, что выпали в прошлом розыгрыше, потому что этот от прошлого НИКАК не зависит удачи вам!
Спасибо Вам большое МатросНаЗебре!! Попробовал я этот код выдаёт ошибку! В разных местах листа я размещал комбинации, выдаёт ошибку одну и тожу! Могли бы Вы выставить Макрос Excel-файл с примерами, хотелось бы глянуть как у Вас работает! Гляньте на код с ошибкой на картинке! Спасибо за код и за то, что не прошли мимо и не остались равнодушными
Вот это да! Настоящее чудо произошло! Радости у меня как у ребёнка! С такими как Вы не страшно в бой идти! При моей удаче в игре, я Вас не забуду! Обязательно Вас я отблагадарю финансово. А я надеюсь на успех и удачу! Кроме всего прочего Вам преогромное спасибо! Оставайтесь здоровыми и успешными! Нет слов от успеха!
МатросНаЗебре, я прошу прощения, если я Вас отвлекаю от дел! Можно ли как то это исправить? Генерируется какая то комбинация например 1 2 10 35 36 39 Первые 3 числа остаются без изменений-это нормально! Создаются еще дополнительные дубли этой комбинации Например: 1 2 10 36 35 39 или 1 2 10 39 35 39 То есть создались лишние дубли с перестановкой 3 последних чисел А также в комбинации повторяются одинаковые числа например: 1 2 10 36 36 38 или 1 2 10 36 38 36 Спасибо! Прилагаю фото.
Sub Спортлото89()
Dim arr As Variant
arr = GetArr(Range("A1:G1"))
Range("B2").Resize(UBound(arr, 1), UBound(arr, 2)) = arr
End Sub
Function GetArr(r As Range) As Variant
Dim s As Long
s = r.Cells(1, 1).Value
Dim arr As Variant
arr = r.Range("B1:G1")
Dim x As Long
Dim y As Long
y = 1
For x = UBound(arr, 2) To 1 Step -1
If arr(1, x) = "" Then
y = y * 49
End If
Next
Dim brr As Variant
If y > Rows.Count - 2 Then y = Rows.Count - 2
ReDim brr(1 To y, 1 To 6)
If y > 1 Then
Dim i1 As Byte
Dim i2 As Byte
Dim i3 As Byte
Dim i4 As Byte
Dim i5 As Byte
Dim i6 As Byte
y = 0
For i1 = IIf(arr(1, 1) = "", 1, arr(1, 1)) To IIf(arr(1, 1) = "", 49, arr(1, 1))
For i2 = IIf(arr(1, 2) = "", i1 + 1, arr(1, 2)) To IIf(arr(1, 2) = "", 49, arr(1, 2))
For i3 = IIf(arr(1, 3) = "", i2 + 1, arr(1, 3)) To IIf(arr(1, 3) = "", 49, arr(1, 3))
For i4 = IIf(arr(1, 4) = "", i3 + 1, arr(1, 4)) To IIf(arr(1, 4) = "", 49, arr(1, 4))
For i5 = IIf(arr(1, 5) = "", i4 + 1, arr(1, 5)) To IIf(arr(1, 5) = "", 49, arr(1, 5))
For i6 = IIf(arr(1, 6) = "", i5 + 1, arr(1, 6)) To IIf(arr(1, 6) = "", 49, arr(1, 6))
If s = i1 + i2 + i3 + i4 + i5 + i6 Then
y = y + 1
brr(y, 1) = i1
brr(y, 2) = i2
brr(y, 3) = i3
brr(y, 4) = i4
brr(y, 5) = i5
brr(y, 6) = i6
End If
If y = UBound(brr, 1) Then Exit For
Next
If y = UBound(brr, 1) Then Exit For
Next
If y = UBound(brr, 1) Then Exit For
Next
If y = UBound(brr, 1) Then Exit For
Next
If y = UBound(brr, 1) Then Exit For
Next
If y = UBound(brr, 1) Then Exit For
Next
End If
GetArr = brr
End Function
Количество генерируемых комбинаций совпадает! По вертикали 4 столбец есть немного отличия у МатросНаЗебре, допустим числа на одной вертикали одно под другим собраны рядом у вас эти комбинации в другом месте, самое главное что сгенерируемы все возможные комбинации, Три макроса хороши! Я взял десятую строку(горизонталь) и сверил все 3 Макроса. У Игоря и МатросНаЗебре,совпадают а у MCH расхождение совпадения по строкам.
Спасибо Вам! Вы просто молодцы! А Вы заметили какие то не совпадения? Если да, покажите на скриншоте!
Я взял десятую строку(горизонталь) и сверил все 3 Макроса. У Игоря и МатросНаЗебре,совпадают а у MCH расхождение совпадения по строкам. Игорь, Спасибо Вам большое тоже! Все молодцы!
MCH написал: Известно 4 числа: 8-12-14-39 Желаемая сумма 111
Результат будет никакой, потому что после 39 идёт число 40 и тогда не получается желаемая сумма. Это так должно быть, это хорошо. Идёт отбор комбинаций под желаемую сумму. Если комбинация не вписалась в желаемую сумму она выбрасывается для использования. Из списка сгенерированных комбинаций я их проверяю под мою желаемую сумму, если какая то комбинация не вписалась под желаемую сумму, то она удаляется. Спасибо!
MCH написал: Ну значит я не правильно понял задачу
Уважаемый MCH!!! Вы Макрос написали хорошо и правильно как Игорь, МатросНаЗебре и Вы! Количество комбинаций совпадает у всех трёх человек. У них совпадало построчно, потому что автоматом было отсортировано. Ваш макрос сгенерировал комбинации потом я вручную сделал сортировку по возрастанию и все макросы совпали по работе. Спасибо Вам! Приятно с Вами всеми работать!