Доброго здоровья всем! Помогите пожалуйста решить детскую задачку по математике с помощью Эксель. Когда-то в школе в виде дополнительного задания на дом дали следующую задачу: УДАР+УДАР =ДРАКА. Надо вместо букв подставить цифры, чтобы выражение было верно. (Одна буква=одна цифра). Да и на олимпиадах такие задачи были в средних классах. Первый раз я её долго делал (типа перебором). Позже понял, что такие задачи решаются за несколько минут путем логических рассуждений. Наверно, чтобы решить её при помощи Эксель надо гораздо больше времени (Мне так кажется). Как это сделать при помощи формул вообще не представляю (в формулах не силен). Макросом можно попробовать, но никогда такие задачи не решал. Обычно берем данные с листа, что-то делаем с ними и выгружаем на лист. Очень хотелось бы посмотреть, как это сделать в Эксель. Заранее благодарен за предложенные варианты (Формула или макрос без использования всяких надстроек)
P.S. Для разнообразия и проверки универсальности решения КИС+КСИ=ИСК
Изменено: Евгений Смирнов - 15.01.2022 15:30:03(Исправил ошибку в последней строке)
MCH Да последнее выражение с ошибкой =ИСК ( Ну более 40 лет прошло подзабыл к сожалению не всё помню со школы) Ваш файл глянул но пока не понял сейчас некогда разбираться. В принципе наверно лучше это как-то кодом сделать чем поиском решения в принципе комп и методом подбора может сделать. Главное правильно условия проверки прописать
Решение математических буквенно-числовых ребусов в Excel. (Криптоарифметическая задача)
Код
Для удара (каникулярная задача) можно так (2Удара=Драка):
=ИНДЕКС(СТРОКА(1000:9999);
ПОИСКПОЗ(ИСТИНА;2*СТРОКА(1000:9999)=--(ПСТР(СТРОКА(1000:9999);2;1)&ПСТР(СТРОКА(1000:9999);4;1)&
ПСТР(СТРОКА(1000:9999);3;1)&A10&ПСТР(СТРОКА(1000:9999);3;1));0))
для 3 буквенных так же формирование 3-ех вспомогательных массивов, но тут попроще буквы все повторяются:
КИС: =СТРОКА(100:999)
КСИ: =ПСТР(СТРОКА(100:999);1;1)&ПСТР(СТРОКА(100:999);3;1)&ПСТР(СТРОКА(100:999);2;1)
ИСК: =ПСТР(СТРОКА(100:999);2;1)&ПСТР(СТРОКА(100:999);3;1)&ПСТР(СТРОКА(100:999);1;1)
в 3-ем ищем сумму первых 2-ух: =СТРОКА(100:999)--(ПСТР(СТРОКА(100:999);1;1)&ПСТР(СТРОКА(100:999);3;1)&ПСТР(СТРОКА(100:999);2;1))
Мне не очень нравится вариант провеки исползуемый в №7 но всеж модифицируем чтоб небыло доп столбцов и ячеек. =SUM(IFERROR(MMULT(ROW(1000:9999)*(2*ROW(1000:9999)=--(MID(ROW(1000:9999);2;1)&MID(ROW(1000:9999);4;1)&MID(ROW(1000:9999);3;1)&COLUMN(A:J)-1&MID(ROW(1000:9999);3;1)));ROW(1:10)^0);))
Прошу прощения, но вчера не все сообщения посмотрел внимательно (Времени не было). Сегодня исправляюсь. Тимофеев Вы просто умница и формулу написали и с карандашом можете решить Браво!!!. В способностях БМВ я уже давно не сомневаюсь. Обе формулы рабочие. Использование подбора параметра для решения наверно можно, но скорее всего надо еще какие формулы добавлять. Только целевая формула это мало. Раз формулы от Тимофеева и БМВ практически мгновенно выдают результат, то и другие методы при правильном наборе входных параметров и условий должны сразу давать результат. Еще раз благодарю всех кто откликнулся и потратил своё драгоценное время на эту тему.
Sub main()
Dim u, d, a, r, k
For u = 5 To 9
d = 1
For r = 2 To 9
If r <> u Then
a = r * 2 Mod 10
If a <> u And a <> r Then
For Each k In Array(0, 2, 3, 4, 5, 6, 7, 8, 9)
If k <> u And k <> a And k <> r Then
If (u * 1000 + d * 100 + a * 10 + r) * 2 = d * 10000 + r * 1000 + a * 100 + k * 10 + a Then
MsgBox u & d & a & r & " + " & u & d & a & r & " = " & d & r & a & k & a
Exit Sub
End If
End If
Next k
End If
End If
Next r
Next u
End Sub
Для общей задачи можно перебрать все размещения из 10 по 5 и прорешать каждый вариант, количество вариантов не очень большое (10!/5 ! = 30240)
MCH Здравствуйте. Вы видимо настойчивый все-таки написали макрос, не пожалели время. Мне проще с макросом, с ним точно разберусь. По формулам не тяну до БМВ и Тимофеева. Спасибо огромное за помощь и мое сэкономленное время.
PS С кодом разобрался быстро. В принципе несложно. Просто никогда не видел такого. Там только небольшой недочет. Присвоение значения переменной d надо сразу писать после объявления переменных (зачем 5 раз гонять в цикле)
Универсальный способ, подходящий для любого подобного ребуса АТАКА + УДАР + УДАР = НОКАУТ 93989 + 7492 + 7492 = 108973
Перебираем все размещения из 10 по 8, проверяем на правильность отдельной функцией (здесь как раз можно настроить любую проверку, под любой ребус) если есть решение - выводим результат С поиском решения справляется за пару секунд
Код
'АТАКА + УДАР + УДАР = НОКАУТ
Sub mainSet()
Dim n As Long, m As Long, i As Long, txt As String, a() As Long
n = 10
m = 8
ReDim a(1 To m) As Long
For i = 1 To m: a(i) = i: Next i
Do
txt = CheckWords(a(1) - 1, a(2) - 1, a(3) - 1, a(4) - 1, a(5) - 1, a(6) - 1, a(7) - 1, a(8) - 1)
If txt <> "" Then
Debug.Print txt
MsgBox txt
Exit Do
End If
Loop While NextSet(a(), n, m)
End Sub
Function CheckWords(a As Long, t As Long, k As Long, u As Long, d As Long, r As Long, n As Long, o As Long) As String
If a = 0 Or u = 0 Or n = 0 Then Exit Function
If a * 10101 + t * 1000 + k * 10 + (u * 1000 + d * 100 + a * 10 + r) * 2 = _
n * 100000 + o * 10000 + k * 1000 + a * 100 + u * 10 + t Then _
CheckWords = a & t & a & k & a & " + " & u & d & a & r & " + " & u & d & a & r & " = " & n & o & k & a & u & t
End Function
Function NextPerm(a() As Long, n As Long) As Boolean 'следующая перестановка в лексикографическом порядке
Dim i As Long, k As Long, t As Long, tmp As Long
For k = n - 1 To 1 Step -1
If a(k) < a(k + 1) Then Exit For
Next k
If k Then
For i = n To k + 1 Step -1
If a(k) < a(i) Then tmp = a(k): a(k) = a(i): a(i) = tmp: Exit For
Next i
NextPerm = True
End If
t = n
For i = k + 1 To (n + k) \ 2
tmp = a(i): a(i) = a(t): a(t) = tmp
t = t - 1
Next i
End Function
Function NextSet(a() As Long, n As Long, m As Long) As Boolean 'следующее размещение
Dim b() As Long, c() As Boolean, i As Long, j As Long
ReDim b(1 To n) As Long, c(1 To n) As Boolean
For i = 1 To m
b(i) = a(i)
c(a(i)) = True
Next i
For j = n To 1 Step -1
If Not c(j) Then
b(i) = j
i = i + 1
End If
Next j
NextSet = NextPerm(b, n)
For i = 1 To m
a(i) = b(i)
Next i
End Function
Здравствуйте Светлый Спасибо за отклик. Насколько я понял у вас немного урезан диапазон перебора значений конкретно для этой задачи. Когда писал тему думал будет куча макросов, а оказалось наоборот макрос только MCH пишет, а формул уже 3. Хотя я больше склоняюсь к решению макросом, с ними мне проще.
MCH Здравствуйте. Классно!!! Спасибо. Меня совсем лишили возможности, что-то написать самому. Кстати первый макрос очень быстро работает. Я так и не смог замерить время, показывает одни нули после запятой. Формулы все таки чуток заметно, что считают. Поэтому для этой задачи все-таки лучше решение макросом. Сейчас попробовал с карандашом одно выражение решить, за 5 минут не получилось. Давно уже не решал. Вообщем разобрал выражение ДЕДКА + БАБКА + РЕПКА = СКАЗКА Здесь не единственное решение есть ещё (Возможно какое-то пропустил) 74750+80850+94650=250250 84850+70750+94650=250250 Исходя из этого может не стоит останавливать цикл, а сохранить первое решение и продолжить поиск и вывести все решения, тогда можно использовать макрос для написания таких ребусов с единственным решением. С последним вашим макросом пока еще не разбирался.
Евгений Смирнов написал: MCH Последний макрос все решения выводит?
В такой интерпретации (сделал перестановки 10 цифр, т.к. используется 9 цифр, убрал перебор размещений), выводит все варианты
Код
Sub main()
Const n As Long = 10
Dim i As Long, a() As Long, tmr As Single
ReDim a(1 To n) As Long
tmr = Timer
For i = 1 To n: a(i) = i - 1: Next i
Do
CheckWords a(1), a(2), a(3), a(4), a(5), a(6), a(7), a(8), a(9)
Loop While NextPerm(a(), n)
Debug.Print Timer - tmr
End Sub
Sub CheckWords(d As Long, e As Long, k As Long, a As Long, b As Long, r As Long, p As Long, s As Long, z As Long)
If d = 0 Or b = 0 Or r = 0 Or s = 0 Then Exit Sub
If d * 10000 + e * 1000 + d * 100 + k * 10 + a + _
b * 10000 + a * 1000 + b * 100 + k * 10 + a + _
r * 10000 + e * 1000 + p * 100 + k * 10 + a = _
s * 100000 + k * 10000 + a * 1000 + z * 100 + k * 10 + a Then _
Debug.Print d & e & d & k & a & " + " & b & a & b & k & a & " + " & r & e & p & k & a & " = " & s & k & a & z & k & a
End Sub
Function NextPerm(a() As Long, n As Long) As Boolean 'следующая перестановка в лексикографическом порядке
Dim i As Long, k As Long, t As Long, tmp As Long
For k = n - 1 To 1 Step -1
If a(k) < a(k + 1) Then Exit For
Next k
If k Then
For i = n To k + 1 Step -1
If a(k) < a(i) Then tmp = a(k): a(k) = a(i): a(i) = tmp: Exit For
Next i
NextPerm = True
End If
t = n
For i = k + 1 To (n + k) \ 2
tmp = a(i): a(i) = a(t): a(t) = tmp
t = t - 1
Next i
End Function
Перебор всех перестановок - 10! (3,6 млн комбинаций) - 3 секунды Если нужен перебор размещений (если используется менее 9 цифр) - см. предыдущую реализацию, можно сократить количество комбинаций для перебора
MCH Спасибо огромное!!! На пару дней вы меня загрузили. С этим макросом сходу не могу разобраться первый был простой. Но я упертый, буду разбираться до полной победы.
Полный перебор всех комбинаций УДАР + УДАР = ДРАКА 8126 + 8126 = 16252 0,3 секунды
Скрытый текст
Код
Sub main()
Const n As Long = 10, m As Long = 5
Dim i As Long, a() As Long, tmr As Single
ReDim a(1 To m) As Long
tmr = Timer
For i = 1 To m: a(i) = i: Next i
Do
Do
CheckWords a(1) - 1, a(2) - 1, a(3) - 1, a(4) - 1, a(5) - 1
Loop While NextPerm(a(), m)
Loop While NextCombin(a(), n, m)
Debug.Print Timer - tmr
End Sub
Sub CheckWords(u As Long, d As Long, a As Long, r As Long, k As Long)
If u = 0 Or d = 0 Then Exit Sub
If (u * 1000 + d * 100 + a * 10 + r) * 2 = _
d * 10000 + r * 1000 + a * 100 + k * 10 + a Then _
Debug.Print u & d & a & r & " + " & u & d & a & r & " = " & d & r & a & k & a
End Sub
Function NextPerm(a() As Long, n As Long) As Boolean 'следующая перестановка в лексикографическом порядке
Dim i As Long, k As Long, t As Long, tmp As Long
For k = n - 1 To 1 Step -1
If a(k) < a(k + 1) Then Exit For
Next k
If k Then
For i = n To k + 1 Step -1
If a(k) < a(i) Then tmp = a(k): a(k) = a(i): a(i) = tmp: Exit For
Next i
NextPerm = True
End If
t = n
For i = k + 1 To (n + k) \ 2
tmp = a(i): a(i) = a(t): a(t) = tmp
t = t - 1
Next i
End Function
Function NextCombin(a() As Long, n As Long, m As Long) As Boolean 'следующее сочетание
Dim i As Long, j As Long
For i = m To 1 Step -1
If a(i) < n - m + i Then
a(i) = a(i) + 1
For j = i + 1 To m
a(j) = a(j - 1) + 1
Next j
NextCombin = True
Exit For
End If
Next i
End Function
Sub main()
Const n As Long = 10, m As Long = 10
Dim i As Long, a() As Long, tmr As Single
ReDim a(1 To m) As Long
tmr = Timer
For i = 1 To m: a(i) = i: Next i
'Do
Do
CheckWords a(1) - 1, a(2) - 1, a(3) - 1, a(4) - 1, a(5) - 1, a(6) - 1, a(7) - 1, a(8) - 1, a(9) - 1, a(10) - 1
Loop While NextPerm(a(), m)
'Loop While NextCombin(a(), n, m)
Debug.Print Timer - tmr
End Sub
Sub CheckWords(o As Long, t As Long, v As Long, e As Long, c As Long, n As Long, b As Long, p As Long, r As Long, s As Long)
If o = 0 Or p = 0 Then Exit Sub
If o * 10000 + t * 1000 + v * 100 + e * 10 + t + _
o * 10000 + c * 1000 + e * 100 + n * 10 + b = _
p * 10000 + r * 1000 + o * 100 + s * 10 + t Then _
Debug.Print o & t & v & e & t & " + " & o & c & e & n & b & " = " & p & r & o & s & t
End Sub
Function NextPerm(a() As Long, n As Long) As Boolean 'следующая перестановка в лексикографическом порядке
Dim i As Long, k As Long, t As Long, tmp As Long
For k = n - 1 To 1 Step -1
If a(k) < a(k + 1) Then Exit For
Next k
If k Then
For i = n To k + 1 Step -1
If a(k) < a(i) Then tmp = a(k): a(k) = a(i): a(i) = tmp: Exit For
Next i
NextPerm = True
End If
t = n
For i = k + 1 To (n + k) \ 2
tmp = a(i): a(i) = a(t): a(t) = tmp
t = t - 1
Next i
End Function
Sub main()
Const n As Long = 10, m As Long = 6
Dim i As Long, a() As Long, tmr As Single
ReDim a(1 To m) As Long
tmr = Timer
For i = 1 To m: a(i) = i: Next i
Do
Do
CheckWords a(1) - 1, a(2) - 1, a(3) - 1, a(4) - 1, a(5) - 1, a(6) - 1
Loop While NextPerm(a(), m)
Loop While NextCombin(a(), n, m)
Debug.Print Timer - tmr
End Sub
Sub CheckWords(n As Long, i As Long, t As Long, k As Long, a As Long, b As Long)
If n = 0 Or t = 0 Then Exit Sub
If n * 10000 + i * 1000 + t * 100 + k * 10 + a + _
n * 10000 + i * 1000 + t * 100 + k * 10 + a = _
t * 10000 + k * 1000 + a * 100 + n * 10 + b Then _
Debug.Print n & i & t & k & a & " + " & n & i & t & k & a & " = " & t & k & a & n & b
End Sub
Function NextPerm(a() As Long, n As Long) As Boolean 'следующая перестановка в лексикографическом порядке
Dim i As Long, k As Long, t As Long, tmp As Long
For k = n - 1 To 1 Step -1
If a(k) < a(k + 1) Then Exit For
Next k
If k Then
For i = n To k + 1 Step -1
If a(k) < a(i) Then tmp = a(k): a(k) = a(i): a(i) = tmp: Exit For
Next i
NextPerm = True
End If
t = n
For i = k + 1 To (n + k) \ 2
tmp = a(i): a(i) = a(t): a(t) = tmp
t = t - 1
Next i
End Function
Function NextCombin(a() As Long, n As Long, m As Long) As Boolean 'следующее сочетание
Dim i As Long, j As Long
For i = m To 1 Step -1
If a(i) < n - m + i Then
a(i) = a(i) + 1
For j = i + 1 To m
a(j) = a(j - 1) + 1
Next j
NextCombin = True
Exit For
End If
Next i
End Function
MCH Спасибо за ссылку. Файл очень помог разобраться. Правда пришлось почитать про комбинаторику, перемещения, сочетания, размещения.(Восполнить пробел из-за пропущенных лекций). Можно считать, что обучение прошло успешно. Выкладываю домашнее задание для разнообразия решений. Правда по скорости это не лучшее решение. Оказывается в этих макросах сильно влияет на скорость тип переменных. К сожалению в моем коде переменные Zx нельзя объявить типом Long.
Код
Sub mainForEach() 'УДАР+УДАР=ДРАКА
Dim Z1, Z2, Z3, Z4, Z5, Z6, Z7, Z8, Z9, tmr!: tmr = Timer
a1 = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9)
For Each Z1 In a1
a2 = Filter(a1, Z1, 0, 1)
For Each Z2 In a2
a3 = Filter(a2, Z2, 0, 1)
For Each Z3 In a3
a4 = Filter(a3, Z3, 0, 1)
For Each Z4 In a4
a5 = Filter(a4, Z4, 0, 1)
For Each Z5 In a5
If (Z1 * 1000 + Z2 * 100 + Z3 * 10 + Z4) * 2 = Z2 * 10000 + Z4 * 1000 + Z3 * 100 + Z5 * 10 + Z3 Then
Debug.Print Z1 & Z2 & Z3 & Z4 & " + " & Z1 & Z2 & Z3 & Z4 & " = " & Z2 & Z4 & Z3 & Z5 & Z3
Debug.Print FormatNumber(Timer - tmr, 4)
Exit Sub
End If
Next Z5
Next Z4
Next Z3
Next Z2
Next Z1
'Debug.Print FormatNumber(Timer - tmr, 4)
End Sub