|
本帖最后由 lsdongjh 于 2020-2-3 17:05 编辑
递归解法,- Option Explicit
- Dim arrResult As Variant
- Sub Test()
- Dim arr As Variant, brr As Variant
- Dim dblVal As Double, dblOld As Double, blGet As Boolean
- arr = Sheet1.Range("B2:G2")
- ReDim brr(1 To 1, 1 To 6) As Long
- dblVal = Round(Sheet1.Range("B1").Value, 1)
-
- blGet = GetNum(arr, dblVal, brr, 1)
-
- If blGet Then
- MsgBox "找到最佳解法!"
- Else
- MsgBox "没有最佳解法,即将尝试进行接近值的解法!"
-
- Do While blGet = False
- dblVal = dblVal + 0.1
- ReDim brr(1 To 1, 1 To 6) As Long
- blGet = GetNum(arr, dblVal, brr, 1)
- Loop
-
- MsgBox "找到最接近的解法!"
- End If
-
- Sheet1.Range("B3").Resize(1, 6) = arrResult
- End Sub
- Function GetNum(arr As Variant, dblSum As Double, brr As Variant, lngColID As Long) As Boolean
- Dim dblTemp As Double, arrTemp As Variant
- Dim blOK As Boolean, lngID As Long
-
- arrTemp = brr
- arrTemp(1, lngColID) = arrTemp(1, lngColID) + 1
-
- dblTemp = Application.WorksheetFunction.SumProduct(arr, arrTemp)
-
- If dblTemp = dblSum Then
- arrResult = arrTemp
- GetNum = True
- Exit Function
- ElseIf dblTemp > dblSum Then
- arrTemp(1, lngColID) = arrTemp(1, lngColID) - 1
- lngColID = lngColID + 1
- If lngColID > UBound(arrTemp, 2) Then
- lngColID = 0
- For lngID = UBound(arrTemp, 2) - 1 To 1 Step -1
- If arrTemp(1, lngID) > 0 Then
- arrTemp(1, lngID) = arrTemp(1, lngID) - 1
- lngColID = lngID + 1
- Exit For
- End If
- Next
- If lngColID = 0 Then
- GetNum = False
- Exit Function
- End If
- End If
- End If
-
- blOK = blOK Or GetNum(arr, dblSum, arrTemp, lngColID)
-
- GetNum = blOK
- End Function
复制代码
|
|