Dim temStr As String
Dim bresult, cresult As Double
 pos = -1
Dim lastResult As Double
Dim maxValue As Integer
maxValue = 99
For a = 32 To maxValue   '循环体a
    For b = 32 To maxValue '循环体b
        bresult = a / b
        For c = 32 To maxValue '循环体c
          cresult = bresult * c
         
             For d = 32 To maxValue '循环体d ，在循环体d中计算是否存在a，b，c，d满足挂比精度
                   Dim result As Double    '循环体d中，abcd此时相应为32 to 100中的值，比如第一次循环时a=32，b=32，c=32，d从32到100循环执行以下语句后退出；
                                         '循环体c中，c加1，继续a=32，b=32，c=33，d从32到100循环执行判断挂比公式后退出
                                         '循环体b中，c循环执行32到100后，b加1，此时a=32，b=33，
                 
                   result = cresult / d  '按照挂比公式计算a，b，c，d的挂比值
                    For i = 0 To 5
                        If r(i) <> 0 Then
                           If Abs(result - r(i)) <= min Then '判断是否满足小于等于精度min
                  
                              If Judge(a, b, c, d, i) = True Then
                                  'Text2.Text = Text2.Text + "A:" + CStr(a) + ",     B:" + CStr(b) _
                                  ' + ",     C:" + CStr(c) + ",     D:" + CStr(d) _
                                  '+ ",     实际计算结果：" + CStr(result) + Chr(13) + Chr(10) '在text2中输出计算结果
                                  pos1(i) = pos1(i) + 1
                                  t(i, pos1(i)) = str
                              End If
                          End If
                       End If
                    Next i
                    If lastResult > rmin Then
                       If rmin > result Then
                          Exit For
                       End If
                    End If
                    lastResult = result
              
               Next d '循环体d，结束 执行到d为100后，退出；c加1后，继续执行循环体d
           
           
        Next c '循环体c，结束 执行到c为100后，退出；b加1后，继续执行循环体c，d
    Next b '循环体b，结束  执行到b为100后，退出；a加1后，继续执行循环体b，c，d
Next a     '循环体a，结束  执行到a为100后，退出；执行下面语句，If Text2.Text = "" Then

For i = 0 To 5 '输出结果，循环5次
    Text2.Text = Text2.Text + Chr(13) + Chr(10) + Chr(13) + Chr(10) + CStr(i + 1) + "、挂比值" + Text1(i).Text + ":" + Chr(13) + Chr(10) '输出挂比值与换行
   Text2.Text = Text2.Text + "( a / c )*( b / d )" + Chr(13) + Chr(10) + "----------------------------"
   
    For j = 0 To pos1(i) '循环输出挂比值i的所有挂轮值
        
        Text2.Text = Text2.Text + t(i, j)
    Next j
   
    Text2.Text = Text2.Text  '换行
Next i


'If Text2.Text = "" Then '执行挂比值判断前将text2.text=""，如果没有满足精度的挂比，输出提示
'   MsgBox ("无此挂轮，请调整滚比值或计算精度")
'   Text2.Text = "无此挂轮，请调整滚比值或计算精度"
'End If
 

End Sub

Function Judge(ByVal a As Integer, ByVal b As Integer, ByVal c As Integer, ByVal d As Integer, ByVal i As Integer) As Boolean
'该函数判断是否已存在相同挂轮
   Dim exist As Boolean
   exist = True
   If a <= c Then
      
      str = Chr(13) + Chr(10) + "  " + CStr(a) + " / " + CStr(c) + "  "
   Else
      str = Chr(13) + Chr(10) + "  " + CStr(c) + " / " + CStr(a) + "  "
   End If
   If b <= d Then
      str = str + " X  " + CStr(b) + " / " + CStr(d) + "  "
   Else
      str = str + " X  " + CStr(d) + " / " + CStr(b) + "  "
   End If
   For j = 0 To pos1(i)
      If t(i, j) = str Then
         exist = False
         Exit For
      End If
   Next j
   If ((a + b - c > 30) And (a + b > 84) And (a + b < 169) And (c + d - b > 30) _
               And (a <> b) And (b <> c) And (c <> d) And (a <> c) And (b <> d) And (a <> d)) And (a * d <> c * b) Then

      exist = exist
   Else
      exist = False
      
   End If
   
   Judge = exist
   
End Function