任意五个数的修约问题

Question

任意的五个含有一位小数的数（都是正数），但其和为100，按照一定的方式修约使他们变成整数，且总和还为100
例如：a(1)=89.4     a(2)=2.4     a(3)=2.7     a(4)=2.8      a(5)=2.7
修约方式为：
1. a(1)中的数值按照四舍五入的规则变成整数，其他的数则是直接去掉小数点后面的数变成整数
2. 如果修约之后这五个数之和不等于100，则在a(2)，a(3)，a(4)，a(5)这四个数中挑选小数部分最大的数将它进一，如果a(2)，a(3)，a(4)，a(5)这四个数有相等的情况，就按照a(2)，a(3)，a(4)，a(5)的顺序挑选前面的数进一，其他的数则是直接去掉小数点后面的数变成整数
3. 如果修约一次之后的五个数还是不等于100，则按照上面的方式将剩下的数再修约一次，直至修约之后的五个数之和为100例如上面的数修约如下：
第一次修约：a(1)=89    a(2)=2     a(3)=2    a(4)=2      a(5)=2  
其和不等于100
第二次修约：a(1)=89     a(2)=2     a(3)=2     a(4)=3      a(5)=2
其和还是不等于100
第三次修约：a(1)=89     a(2)=2     a(3)=3     a(4)=3      a(5)=2
其和还是不等于100
第四次修约：a(1)=89     a(2)=2     a(3)=3     a(4)=3      a(5)=3
五个数和为100，修约结束
这五个数其值为：a(1)=89     a(2)=2     a(3)=3     a(4)=3      a(5)=3对于任意的五个含有一位小数的数（都是正数），但其和为100，怎么用VB语言编写使他们按照上面的要求变成整数，且总和还为100？
本人刚学VB，希望得到高手的指点啊？

Answer 1

给你一个思路，注意这个示例数组的起始下标是从0开始的，要任意起始下标还要修改：Private Sub Command1_Click()    Dim a(4) As Double
    Dim m As Long
    
    a(0) = 89.4: a(1) = 2.4: a(2) = 2.7: a(3) = 2.8: a(4) = 2.7
    m = 100
    
    If SumReturn(a, m) Then
        For m = 0 To 4
            a(m) = Int(a(m))
            Debug.Print a(m);
        Next
    Else
        Debug.Print "数组条件不能得到结果"
    End If
    Debug.Print
    
End SubFunction GetIndex(pNum() As Double, pLength As Long) As Long
    Dim Idx As Long
    Dim i As Long
    Dim x As Double
    
    For i = 1 To pLength
        If pNum(i) - Int(pNum(i)) > x Then Idx = i
    Next
    GetIndex = Idx
End FunctionFunction SumReturn(pNum() As Double, pSumNum As Long) As Boolean
    Dim Length As Long
    Dim Total As Long
    Dim xCount As Long
    Dim x As Long
    Dim Idx As Long
    Dim i As Long
    
    Length = UBound(pNum)
    pNum(0) = Format(pNum(0), "#") '第一个元素四舍五入
    
    Do
        Total = 0
        For i = 0 To Length
            Total = Total + Int(pNum(i))
        Next
        
        If Total = pSumNum Then
            SumReturn = True
            Exit Function
        End If
    
        If xCount > Length Then
            SumReturn = False
            Exit Function
        End If
        
        Idx = GetIndex(pNum, Length)
        pNum(Idx) = Int(pNum(Idx)) + 1
        xCount = xCount + 1
    Loop
    
End Function只是一个示例，没有严格测试，需要优化和完善....

Answer 2

错了，重贴Private Sub Command1_Click()    Dim a(4) As Double
    Dim m As Long
    
    a(0) = 89.4: a(1) = 2.4: a(2) = 2.7: a(3) = 2.8: a(4) = 2.7
    m = 100
    
    If SumReturn(a, m) Then
        For m = 0 To 4
            a(m) = Int(a(m))
            Debug.Print a(m);
        Next
    Else
        Debug.Print "数组条件不能得到结果"
    End If
    Debug.Print
    
End Sub
'这个函数返回数组中小数位数最大的元素下标
Function GetIndex(pNum() As Double, pLength As Long) As Long
    Dim Idx As Long
    Dim i As Long
    Dim x As Double
    For i = 1 To pLength
        If pNum(i) - Int(pNum(i)) > x Then
            Idx = i
            x = pNum(i) - Int(pNum(i))
        End If
    Next
    GetIndex = Idx
End FunctionFunction SumReturn(pNum() As Double, pSumNum As Long) As Boolean
    Dim Length As Long
    Dim Total As Long
    Dim xCount As Long
    Dim x As Long
    Dim Idx As Long
    Dim i As Long
    
    Length = UBound(pNum)
    pNum(0) = Format(pNum(0), "#") '第一个元素四舍五入
    
    Do
        Total = 0
        For i = 0 To Length
            Total = Total + Int(pNum(i))
        Next
        
        If Total = pSumNum Then
            SumReturn = True
            Exit Function
        End If
    
        If xCount > Length Then
            SumReturn = False
            Exit Function
        End If
        
        Idx = GetIndex(pNum, Length)
        pNum(Idx) = Int(pNum(Idx)) + 1
        xCount = xCount + 1
    Loop
    
End Function

Answer 3

哦，上面示例中，函数SumReturn中do循环的退出条件错了，应该是If xCount = Length Then就退出，不然要多算一次，结果有可能不正确了.....

Answer 4

大部分可以看懂，只是
If pNum(i) - Int(pNum(i)) > x Then
            Idx = i
            x = pNum(i) - Int(pNum(i))
        End If
这部分的意思没看明白，还烦请解释一下哦！
尤其其中的x所起的作用，谢谢

Answer 5

其实我这个代码比较直白，加上点注释吧：Option ExplicitPrivate Sub Command1_Click()
    Dim a(4) As Double
    Dim m As Long
    a(0) = 89.4: a(1) = 2.4: a(2) = 2.7: a(3) = 2.8: a(4) = 2.7
    m = 100
    If SumReturn(a, m) Then     '如果符合结果，修改数组元素并打印
        For m = 0 To 4
            a(m) = Int(a(m))
            Debug.Print a(m);
        Next
    Else
        Debug.Print "数组条件不能得到结果"
    End If
    Debug.Print
End Sub'这个函数返回数组中小数位数最大的元素下标
Function GetIndex(pNum() As Double, pLength As Long) As Long
    Dim Idx As Long
    Dim i As Long
    Dim x As Double, y As Double
    For i = 1 To pLength
        y = pNum(i) - Int(pNum(i)) '得到当前元素小数部分的值
        If y > x Then   '如果小数部分大于已经记录的值
            Idx = i     '记录当前元素的下标
            x = y       '记录当前元素小数部分的值，用于比较其它元素的小数部分的值
        End If
    Next
    GetIndex = Idx
End FunctionFunction SumReturn(pNum() As Double, pSumNum As Long) As Boolean
    Dim Length As Long
    Dim Total As Long
    Dim xCount As Long
    Dim x As Long
    Dim Idx As Long
    Dim i As Long
    
    Length = UBound(pNum)           '数组的最大下标
    pNum(0) = Format(pNum(0), "#")  '第一个元素四舍五入
    
    Do
        '循环数组，每个元素取整求和
        Total = 0
        For i = 0 To Length
            Total = Total + Int(pNum(i))
        Next
        '如果求和结果满足要求，结束计算，函数返回true
        If Total = pSumNum Then
            SumReturn = True
            Exit Function
        End If
        '如果数组全部进位了，依然得不到结果，结束计算，函数返回false
        If xCount = Length Then
            SumReturn = False
            Exit Function
        End If
        '找到数组中小数部分最大的元素进位
        Idx = GetIndex(pNum, Length)
        pNum(Idx) = Int(pNum(Idx)) + 1
        '记录计算次数
        xCount = xCount + 1
    Loop
    
End Function整个代码条件是数组下标从0开始，数组每个元素必须都是小数...

Answer 6

实际上视你具体应用，SumReturn还可以加一个退出条件:
If Total > pSumNum Then
    SumReturn = False
    Exit Function
End If
就是计算和大于指定要求的值，就可退出了，因为元素再进位，只会使和更大....

Answer 7

学习了
知道了clng函数是四舍五入，不是抛弃小数部分。

Answer 8

clng和round一样，不是四舍五入吧，要看整数部分的奇偶...
只知道format才是四舍五入...
对这个研究的不多，还有什么真正的四舍五入函数或方法，谁介绍学习下...

Answer 9

还真是，不小心被MSDN的翻译骗了
呵呵

Answer 10

cint,clng,round，当要转换的数值小数部分正好是5时，都转换为最接近的偶数....
真想不通为什么（全都）要这样？

Answer 11

用format四舍五入，其实感觉真别扭...要是在大量反复需要转换的运算中，效率也不高....

Answer 12

do while int(lna(1))+int(lna(2))+int(lna(3))+int(lna(4))+int(lna(5))=100
   for i=1 to 5
   input('please input:') to lma(i)
   endfor
enddo
   

Answer 13

dime lna(5)
for i=1 to 5
   input('please input一位小数的正数:') to lna(i)
   lca(i)=str(lna(i))
   lcarightend(i)=right(lca(i),1)
   lna(1)=round(lna(1),0) 
   lna(2)=int(lna(2)),lna(3)=int(lna(3)),lna(4)=int(lna(4)),lna(5)=int(lna(5)),
endfor
if lna(1)+lna(2)+lna(3)+lna(4)+lna(5)=100
   return
endif
do while lna(1)+lna(2)+lna(3)+lna(4)+lna(5)!=100
do case 
   case max(val(lcarightend(2)),val(lcarightend(3)),val(lcarightend(4)),;
            val(lcarightend(5)),))=val(lcarightend(2))
        lna(2)=ceiling(lna(2)) 
   case max(val(lcarightend(2)),val(lcarightend(3)),val(lcarightend(4)),;
            val(lcarightend(5)),))=val(lcarightend(3))
        lna(3)=ceiling(lna(3))
   case max(val(lcarightend(2)),val(lcarightend(3)),val(lcarightend(4)),;
            val(lcarightend(5)),))=val(lcarightend(4))
        lna(4)=ceiling(lna(4)) 
   case max(val(lcarightend(2)),val(lcarightend(3)),val(lcarightend(4)),;
            val(lcarightend(5)),))=val(lcarightend(5))
        lna(5)=ceiling(lna(5)) 
enddo
enddo

Answer 14

dime lna(5)
for i=1 to 5
  input('please input一位小数的正数:') to lna(i)
  lca(i)=str(lna(i))
  lcarightend(i)=right(lca(i),1)
  lna(1)=round(lna(1),0)  
  lna(2)=int(lna(2)),lna(3)=int(lna(3)),lna(4)=int(lna(4)),lna(5)=int(lna(5)),
endfor
if lna(1)+lna(2)+lna(3)+lna(4)+lna(5)=100
  return
endif
?lna(1),lna(2),lna(3),lna(4),lna(5)
do while lna(1)+lna(2)+lna(3)+lna(4)+lna(5)!=100
do case  
  case max(val(lcarightend(2)),val(lcarightend(3)),val(lcarightend(4)),;
  val(lcarightend(5)),))=val(lcarightend(2))
  lna(2)=ceiling(lna(2))  
  case max(val(lcarightend(2)),val(lcarightend(3)),val(lcarightend(4)),;
  val(lcarightend(5)),))=val(lcarightend(3))
  lna(3)=ceiling(lna(3))
  case max(val(lcarightend(2)),val(lcarightend(3)),val(lcarightend(4)),;
  val(lcarightend(5)),))=val(lcarightend(4))
  lna(4)=ceiling(lna(4))  
  case max(val(lcarightend(2)),val(lcarightend(3)),val(lcarightend(4)),;
  val(lcarightend(5)),))=val(lcarightend(5))
  lna(5)=ceiling(lna(5))  
enddo
if lna(1)+lna(2)+lna(3)+lna(4)+lna(5)=100
  return
endif
?lna(1),lna(2),lna(3),lna(4),lna(5)
for i=1 to 5
  input('请参照上述数字手工修约:') to lna(i)
endfor
enddo