网上东拼西凑的代码,使用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