Создание программы подбора шестерен

[Владимир VBA]

Коллеги, помогите начинающему программисту. Потребовалось по работе создать программку для подбора шестерен для получения определенной характеристики обработки из имеющегося набора. Сделал программку, все работает, кроме одной строки кода. Подскажите, кто может, в чем проблема. Код следующий:

Sub Gear_Select_Imroved_Simpled()

' Программа подбора шестерен
Dim A, M, Q, F, W, Z As Variant
' Набор шестерен, имеющихся в наличии
A = Array(23, 24, 26, 28, 30, 32, 35, 38, 40, 44, 46, 48, 50, 55, 60, 62, 64, 67, 72, 80, 82, 83, 88, 96, 100, 106)
' Вводим значение требуемого передаточного числа из ячейки A1
Q = Лист1.Cells(1, 1)
' Вспомогательное промежуточное значение
Z = 10000
i = 0
j = 0
k = 0
n = 0
' Перебор всех сочетаний шестерен
    For i = 0 To 25
        For j = 0 To 25
              For k = 0 To 25
                    For n = 0 To 25
' СЛЕДУЮЩАЯ СТРОКА КОДА - ЗАДАЕТСЯ УСЛОВИЕ, ИСКЛЮЧАЮЩЕЕ ВОЗМОЖНОСТЬ ПРИМЕНЕНИЕ ОДНОЙ И ТОЙ ЖЕ ШЕСТЕРНИ ИЗ НАБОРА ДВАЖДЫ
' ЭТА СТРОКА КОДА НЕ РАБОТАЕТ, ТО ЕСТЬ БЫВАЮТ СЛУЧАИ ПРИМЕНЕНИЯ ОДНОЙ ШЕСТЕРНИ ДВАЖДЫ. В ЭТОМ ВОПРОС
                    If i <> j Or i <> k Or i <> n Or j <> k Or j <> n Or k <> n Then
                        F = 12 * A(i) * A(k) / A(j) / A(n)
                        W = Abs(F - Q)
                            If W < Z Then
                                Z = W
                                Лист1.Cells(2, 1) = A(i)
                                Лист1.Cells(2, 2) = A(j)
                                Лист1.Cells(2, 3) = A(k)
                                Лист1.Cells(2, 4) = A(n)
                            End If
                    End If
                    Next n
              Next k
       Next j
   Next i
    
End Sub

Спасибо, заранее благодарен.

[staniiislav]

пример скиньте

[Владимир VBA]

Так вот же код написал. Там и проблемная строка. Перед ней соответствующий комментарий.
Эта строка должна предотвращать применение одного и того же элемента массива более одного раза, для этого порядковый номер элемента повторяться не должен. Из четырех просчитываемых для набора шестерен, таким образом, любая шестерня может быть применена в составе этого набора только один раз, что и требуется. Но эта строка не работает, из-за этого бывает применение одной шестерни более одного раза. Почему не работает эта строка, в этом вопрос.
Заранее благодарен за ответ.

[eikhner]

Возможно , там не ИЛИ должно быть а И, т.е должны все неравенства проверяться . А у вас проверяется только ИЛИ одно из всего перечисленного, программа нашла одно совпавшее или и пошла считать , а другие условия возможно что и не попадают под это условие . Как говорят гуру - что вы написали - то программа и делает . Может на словах запишите это условие If ......................... Then

[IgorGO]

человеческим языком здесь
If i <> j Or i <> k Or i <> n Or j <> k Or j <> n Or k <> n Then
написано если есть хоть одна несопадающая пара значений, то РАБОТАЕМ

замените все or на and.

[Казанский]

Если вынести повторяющиеся проверки из самого внутреннего цикла и использовать правильные типы переменных, время работы программы сокращается более чем в 4 раза, на моем компе с 2.2 до 0.48 с:

Sub Gear_Select_Imroved_Simpled()

' Программа подбора шестерен
Dim A#(0 To 25), Q#, F#, W#, Z# ' As Variant
Dim F1#, F2#, F3#
Dim i&, j&, k&, n&, t!, x
't = Timer 'для измерения времени
' Набор шестерен, имеющихся в наличии
For Each x In Array(23, 24, 26, 28, 30, 32, 35, 38, 40, 44, 46, 48, 50, 55, 60, 62, 64, 67, 72, 80, 82, 83, 88, 96, 100, 106)
    A(i) = x: i = i + 1
Next
    ' Вводим значение требуемого передаточного числа из ячейки A1
Q = Лист1.Cells(1, 1)
' Вспомогательное промежуточное значение
Z = 10000
'i = 0
'j = 0
'k = 0
'n = 0
' Перебор всех сочетаний шестерен
    For i = 0 To 25
        F3 = 12 * A(i)
        For j = 0 To 25
           If j <> i Then
              F2 = F3 / A(j)
              For k = 0 To 25
                 If k <> i And k <> j Then
                    F1 = F2 * A(k)
                    For n = 0 To 25
' СЛЕДУЮЩАЯ СТРОКА КОДА - ЗАДАЕТСЯ УСЛОВИЕ, ИСКЛЮЧАЮЩЕЕ ВОЗМОЖНОСТЬ ПРИМЕНЕНИЕ ОДНОЙ И ТОЙ ЖЕ ШЕСТЕРНИ ИЗ НАБОРА ДВАЖДЫ
' ЭТА СТРОКА КОДА НЕ РАБОТАЕТ, ТО ЕСТЬ БЫВАЮТ СЛУЧАИ ПРИМЕНЕНИЯ ОДНОЙ ШЕСТЕРНИ ДВАЖДЫ. В ЭТОМ ВОПРОС
                    If n <> i And n <> j And n <> k Then
'                        F = F1 / A(n)
                        W = Abs(F1 / A(n) - Q)
                            If W < Z Then
                                Z = W
                                Лист1.Cells(2, 1).Resize(, 4) = Array(A(i), A(j), A(k), A(n))
'                                Лист1.Cells(2, 2) = A(j)
'                                Лист1.Cells(2, 3) = A(k)
'                                Лист1.Cells(2, 4) = A(n)
                            End If
                    End If
                    Next n
                 End If
              Next k
           End If
       Next j
   Next i
'MsgBox Timer - t 'для измерения времени
End Sub

[Владимир VBA]

Йосиф старенький! Коллеги, гениально. Действительно, надо заменить ИЛИ на И. Как хорошо, что есть на свете умные люди. Спасибо за исправление!
Отдельно большое спасибо, уважаемый коллега Казанский. Потратили время, переписали код, я душевно тронут.
Еще раз спасибо, удачи!

[Hugo121]

Ещё можно чуть ускорить, заменив
If n <> i And n <> j And n <> k Then
на
If n <> i Then
If n <> j Then
If n <> k Then
...
end if
end if
end if

Ну и выше тоже есть одно AND.
Так после первого несовпадения остальные проверки производиться не будут.
Правда в данном случае ускорение будет небольшое, а код станет сложнее вообще и читаться в частности...
Думаю поэтому Алексей сэкономил буквы

[DiemonStar]

Упрощается это другим способом:

If (n-i)*(n-j)*(n-k) <> 0 then

но надо проверять - не факт что в VBA это выражение будет оптимальнее...

[Hugo121]

Ну да, так нужно опросить все 3 переменных (или 6 в общем случае), и произвести ещё 5 арифметических действий (или 4?)
Но зато записано элегантно. Но работает только с числами.