Подбор целых чисел по результату произведения их деления друг на друга

[shanemac51a]

у каждой модели станка --свой комплект шестеренок

Код Выделить Развернуть


Private Sub CommandButton1_Click()
MM130203_2157 Val(Range("e7").Value), Val(Range("e10").Value)

End Sub
Sub MM130203_2157(eps As Double, M0 As Double)
Dim XM, J1, J2, J3, j4, j8, KX1, KX2
'Dim M0 As Double
Dim M1 As Double
'Dim eps As Double
Dim m1abs As Double
Dim m1abs1 As Double
Columns("H:L").Select
Selection.ClearContents
'''''''''''''''''шестерни-конкретного станка-----------------
XM = Split("21,23,25,27,31,32,35,37,38,39,41,42,45,47,50,51,52,55,56,57,58,59,60,61,62,63,65", ",")
'''''''''''''''''передаточн число----------------
Debug.Print (46 / 52) * (22 / 45)            ''ошибка нет 22-45
Debug.Print (46 / 52) * (23 / 47)            '' контрольный расчет


'M0 = 0.43247832      '' (46 / 52) * (23 / 47)

M1 = 1
'eps = 0.000001
m1abs1 = M0 * 2
j8 = 1
KX1 = LBound(XM, 1)
KX2 = UBound(XM, 1)
Debug.Print "--------", Now, "------------"
Debug.Print M0; KX1; KX2; Format((46 / 52) * (23 / 47) - M0, "0.00000000")
J1 = KX1
Do While J1 < KX2
J2 = KX1
Do While J2 < KX2
J3 = KX1
   Do While J3 < KX2
   j4 = KX1
      Do While j4 < KX2
         If J1 = J2 Or J1 = J3 Or J1 = j4 Or J2 = J3 Or J2 = j4 Or J3 = j4 Then
         Else
         M1 = (XM(J3) * XM(j4)) / (XM(J1) * XM(J2))
         m1abs = Abs(M1 - M0)
         If m1abs < m1abs1 Then
            m1abs1 = m1abs
            Debug.Print XM(J1); " "; XM(J2); " "; XM(J3); " "; XM(j4); " "; M0; M1; Format(m1abs, "0.00000000")
            j8 = j8 + 1
            Cells(1, 8) = "ш1"
            Cells(1, 9) = "ш2"
            Cells(1, 10) = "ш3"
            Cells(1, 11) = "ш4"
            Cells(1, 12) = "отклонение"
            Cells(j8, 8) = XM(J1)
            Cells(j8, 9) = XM(J2)
            Cells(j8, 10) = XM(J3)
            Cells(j8, 11) = XM(j4)
            Cells(j8, 12) = Format(m1abs, "0.00000000")
            If m1abs1 < eps Then
            j8 = j8 + 1
            Cells(j8, 8) = "конец расчета"
            Debug.Print "конец расчета"
            Exit Sub
            End If
           
            j4 = j4 + 0
         End If
         End If
         j4 = j4 + 1
      Loop
   
   J3 = J3 + 1
   Loop
J2 = J2 + 1
Loop
J1 = J1 + 1
Loop


End Sub


[el_fantomassito]

MCH,посмотрел Ваш документ, как раз то , что нужно, только есть вопрос можно ли ряд шестерен ввести в тело макроса чтоб его не было видно и можно было добавлять и убирать шестерни.

Еще есть одно условие которое должно выполняться, так называемое "условие сцепляемости", в ячейках в которые выводятся гитары (23/45*55/65 например) должно выполнятся условие 23+45>55+20

[MCH]

так нужно?

[el_fantomassito]

так нужно?

СПАСИБО тоЧТО НУЖНО

[el_fantomassito]

При вводе результата деления более 1 макрос не работает, и как сделать, что бы выполнялось условие:

          i1/i2 * i3/i4.     должно выполняться i1+i2 > i3+20
                                                             i3+i4 > i2+20

[shanemac51a]

Код Выделить Развернуть


Private Sub CommandButton1_Click()
MM130203_2157 0.000001, (46 / 52) * (23 / 47)
MM130203_2157 0.000001, (47 / 52) * (23 / 46)
''В строке нет номера 46
''Есть ряд зубчатых колес 21,23,25,27,31,32,35,37,38,39,41,42,45,47,50,51,52,55,56,57,58,59.60,61,62,63,65.
''(как видим целые числа - это количество зубьев колеса).
''
''Есть расчитанное мной передаточное отношение - 0,43247832
''(результат деления, типа 46:52*22:45)
End Sub
Sub MM130203_2157(eps As Double, M0 As Double)
Dim XM, J1, J2, J3, j4, j8, KX1, KX2
'Dim M0 As Double
Dim M1 As Double
'Dim eps As Double
Dim m1abs As Double
Dim m1abs1 As Double
Columns("H:N").Select
Selection.ClearContents
'''''''''''''''''шестерни-конкретного станка-----------------
XM = Split("21,23,25,27,31,32,35,37,38,39,41,42,45,46,47,50,51,52,55,56,57,58,59,60,61,62,63,65", ",")
'''''''''''''''''передаточн число----------------
Debug.Print (46 / 52) * (22 / 45)            ''ошибка нет 22-45
Debug.Print (46 / 52) * (23 / 47)            '' контрольный расчет
'M0 = (46 / 52) * (23 / 47)

'M0 = 0.43247832      '' (46 / 52) * (23 / 47)

M1 = 1
'eps = 0.000001
m1abs1 = M0 * 1.5
j8 = 1
KX1 = LBound(XM, 1)
KX2 = UBound(XM, 1)
Debug.Print "--", Now, "--"; KX1; KX2; "m0="; M0
Debug.Print M0; KX1; KX2; Format((46 / 52) * (23 / 47) - M0, "0.00000000")
J1 = KX1
Do While J1 < KX2
J2 = 1 ''KX1
Do While J2 < KX2
J3 = 1 ''KX1
Do While J3 < KX2
j4 = 1 ''KX1
Do While j4 < KX2
If J1 = J2 Or J1 = J3 Or J1 = j4 Or J2 = J3 Or J2 = j4 Or J3 = j4 Then
Else
M1 = (XM(J3) * XM(j4)) / (XM(J1) * XM(J2))
m1abs = Abs(M1 - M0)
If m1abs < eps * 1.2 Then
'm1abs1 Then
m1abs1 = m1abs
Debug.Print XM(J1); " "; XM(J2); " "; XM(J3); " "; XM(j4); " "; M0; M1; Format(m1abs, "0.00000000")

' i1 i2 > i3 + 20
' i3 i4 > i2 + 20
j8 = j8 + 1
Cells(1, 8) = "ш1"
Cells(1, 9) = "ш2"
Cells(1, 10) = "ш3"
Cells(1, 11) = "ш4"
Cells(1, 12) = "отклонение"
Cells(j8, 8) = XM(J1)
Cells(j8, 9) = XM(J2)
Cells(j8, 10) = XM(J3)
Cells(j8, 11) = XM(j4)
Cells(j8, 12) = Format(m1abs, "0.00000000")
Cells(1, 13) = "конт12_3"
Cells(1, 14) = "конт34_2"

Cells(j8, 13) = (XM(J1) + XM(J2)) > (XM(J3) + 20)
Cells(j8, 14) = (XM(J3) + XM(j4)) > (XM(J2) + 20)
If Cells(j8, 13) = True And Cells(j8, 13) = True Then
j8 = j8 + 1
Cells(j8, 8) = "конец расчета1"
Debug.Print "конец расчета1"
Exit Sub
End If
If m1abs1 < eps Then
''
End If

j4 = j4 + 0 ''0
End If
End If
j4 = j4 + 1
Loop

J3 = J3 + 1
Loop
J2 = J2 + 1
Loop
J1 = J1 + 1
Loop
j8 = j8 + 1
Cells(j8, 8) = "конец расчета2"
Debug.Print "конец расчета2"
Exit Sub

End Sub



[el_fantomassito]

вот что получилось

[shanemac51a]

подправила внешний вид

[el_fantomassito]

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

[shanemac51a]

у меня считает
может вы не тот макрос по кнопке вызываете