注册 登录
编程论坛 VFP论坛

凑数求助

wengjl 发布于 5 天前 14:23, 208 次点击
只有本站会员才能查看附件,请 登录


现有一列数值,共317个数,要凑出 19138.92 ,在317个数值中,挑哪几个正好能凑到 19138.92   
详见附件
求大侠,能给出代码,不胜感激,谢谢!
8 回复
#2
dglhz5 天前 15:46
笨方法:
SELECT ddje,0 s1 FROM ls ORDER BY ddje desc INTO CURSOR tmp11 readwrite
LOCAL _je0,_je1,_v11,_r11
_v11=0
_je0=19138.92

SELECT tmp11
FOR _r11= 1 TO RECCOUNT('tmp11')
_je1=0
    SCAN FOR s1<9
        IF _je1=0
            _je1=_je0-ddje
        ELSE
            IF _je1-ddje<0
                LOOP
            ELSE
                _je1=_je1-ddje
            ENDIF
        ENDIF

        DO CASE
        CASE _je1>0
            REPLACE s1 WITH 1
        CASE _je1=0
            REPLACE s1 WITH 1
            _v11=1
            exit
        OTHERWISE
            EXIT
        ENDCASE
    ENDSCAN
    IF _v11=1
        SELECT ddje FROM tmp11 WHERE s1=1 INTO CURSOR tmp12
        EXIT
    ELSE
        REPLACE s1 WITH 9 FOR RECNO()=_r11
    ENDIF
endf
IF _v11=1
    MESSAGEbox('凑数成功')
    SELECT tmp12
    brow
ELSE
    MESSAGEbox('凑数失败')
ENDIF
#3
schtg4 天前 06:21
回复 2楼 dglhz
可行,谢谢分享!
只有本站会员才能查看附件,请 登录


[此贴子已经被作者于2025-1-18 06:25编辑过]

#4
星光悠蓝4 天前 18:01
有好多种组合,是什么用途?
只有本站会员才能查看附件,请 登录
#5
wcx_cc4 天前 22:21
要想全部数据搜索完毕,这是一个庞大的组合,应该使用淘汰法
#6
sych3 天前 20:59
网上东拼西凑的代码,使用excel的规划求解,遗憾的是只支持200个数值
TEXT TO vbaCode TEXTMERGE NOSHOW PRETEXT 7
Sub LoadSolver()
    on error resume next
    With Application
        .SendKeys "~"
        .CommandBars.FindControl(ID:=3627).Execute
    End With
    Application.ScreenUpdating = True
    AddIns("规划求解加载项").Installed = True
    AddIns("Solver Add-in").Installed = True
    With ThisWorkbook.VBProject
        For i = 1 To .References.Count
            If .References(i).Name = "Solver" Then
                Exit Sub
            Else
                If i = .References.Count Then
                    ThisWorkbook.VBProject.References.AddFromFile Application.path & "\Library\SOLVER\SOLVER.XLAM"
                End If
            End If
        Next i
    End With
End Sub

Sub UnloadSolver()
    On Error Resume Next
    ThisWorkbook.VBProject.References.Remove ThisWorkbook.VBProject.References("Solver")
    AddIns("规划求解加载项").Installed = False
    AddIns("Solver Add-in").Installed = False
End Sub

Sub sds(maxcell As String)
    On Error Resume Next
    SolverReset
    SolverOk SetCell:="c1", MaxMinVal:=3, ValueOf:=19138.92, ByChange:="B1:B" & maxcell, Engine:=2, EngineDesc:="单纯形 LP"
    SolverOk SetCell:="c1", MaxMinVal:=3, ValueOf:=19138.92, ByChange:="B1:B" & maxcell, Engine:=2, EngineDesc:="Simplex LP"
    SolverAdd CellRef:="B1:B" & maxcell, Relation:=5
    SolverSolve UserFinish:=True,ShowRef:="ShowTrial"
    Range("B1:B" & maxcell).AutoFilter Field:=1, Criteria1:="1"
End Sub

Function ShowTrial(Reason As Integer)
    MsgBox Reason
    ShowTrial = 0
End Function

ENDTEXT

oExcel = CREATEOBJECT("Excel.Application")
oExcel.Visible = 1
regKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\"+oExcel.Version+"\Excel\Security\AccessVBOM"
se = CREATEOBJECT("WScript.Shell")
se.RegWrite(regKey, 1, "REG_DWORD")
oExcel.DisplayAlerts = 0
oExcel.WorkBooks.Add
USE ls
WITH oExcel
    scan
        .cells(RECNO(),1).value=ddje
    ENDSCAN
    maxcell=TRANSFORM(MIN(200,RECCOUNT()))  &&最多支持200个
    .cells(1,3).Formula = "=SUMPRODUCT(a1:a"+maxcell+",b1:b"+maxcell+")"
ENDWITH
myModule = oExcel.ActiveWorkbook.VBProject.VBComponents.Add(1)  && vbext_ct_StdModule = 1
myModule.CodeModule.AddFromString(vbaCode)
oExcel.Run("LoadSolver")
oexcel.Run('sds',maxcell)
**oexcel.Run('ArrayFill', @arrEsj)  && @arrEsj是这个宏的参数.
oExcel.ActiveWorkbook.VBProject.VBComponents.Remove(myModule)
se.RegWrite(regKey, 0, "REG_DWORD")
retu
#7
wengjl前天 10:37
感谢各位的大力帮助!
#8
wengjl前天 10:39
回复 4楼 星光悠蓝
对方多张订单的数据一起给了,要还原订单而要凑数(做账需要)
#9
凝聚双眼昨天 10:11
蛇来运转,万事胜意!
1