可以点样最佳化VBA列阵

新手想求教CHING们，下面基本搵最佳化参数流程，可以点样优化CODE写得冇咁dirty?
有冇快D既搜寻法可以用系VBA?(好似EXCEL Solver)

复制内容到剪贴板代码:
Sub opt_target()
Dim p1 as integer
Dim p2 as integer
Dim m as integer
Dim n as integer
Dim parat (m1 to m2, n1 to n2) as integer
Dim max as double
max = -100
p1 = 0
p2 = 0
For p1 = LBound(parat, 1) to UBound(parat,1) step m 'paratmeter1 for fast
For p2 = LBound(parat, 2) to UBound(parat,2) step n 'paratmeter2 for slow
If p1 < p2, then 'fast < slow
range("parat1") = p1 'enter p1 as paratmeter1
range("parat2") = p2 'enter p2 as paratmeter2
If range("result") > max, then 'seach max result%
max = range("result") 'record max result
opt_p1 = p1 'record optizium fast paratmeter1
opt_p2 = p2 'record optizium slow paratmeter2
End if
End if
Next p2
Next p1
End Sub

作者: alee001   发布时间: 2013-09-21

作者: ricyik   发布时间: 2013-09-21

因为Solver只可以p1<=p2唔可以p1<p2

作者: alee001   发布时间: 2013-09-21

作者: ricyik   发布时间: 2013-09-21

Can you post the data on Google spreadsheet?

This looks interesting.

引用:原帖由 alee001 於 2013-8-21 16:47 发表
新手想求教CHING们，下面基本搵最佳化参数流程，可以点样优化CODE写得冇咁dirty?
有冇快D既搜寻法可以用系VBA?(好似EXCEL Solver)


Sub opt_target()
Dim p1 as integer
Dim p2 as integer
Dim ...

作者: a8d7e8   发布时间: 2013-09-21

因为SOLVER唔可以限制两个参数非相同，除非有其他搜寻法，如果唔系都要用传统LOOPING去SEARCH答案，好晒时间

作者: alee001   发布时间: 2013-09-21

引用:原帖由 alee001 於 2013-8-29 22:03 发表

因为SOLVER唔可以限制两个参数非相同，除非有其他搜寻法，如果唔系都要用传统LOOPING去SEARCH答案，好晒时间

Lagrange multipliers?

作者: a8d7e8   发布时间: 2013-09-21

作者: a8d7e8   发布时间: 2013-09-21

just tried. do u mean this? seems i can add a constraint such that a parameter which i will change is always > another parameter which i will change. see if this is what u mean and see if this helps.

作者: ricyik   发布时间: 2013-09-21

Solver cannot let parameter $C$3>$C$2 or $C$3<>$C$2

作者: alee001   发布时间: 2013-09-21

I had hearing some powerful search algorithms, but there are so complex and need more technique can do that as VBA kid for me, I only used to grid search for solve it.

作者: alee001   发布时间: 2013-09-21

作者: ricyik   发布时间: 2013-09-21

有冇CHING指点小第下面个CODE可以点样优化减少运算时间?

复制内容到剪贴板代码:
Sub grid_search()
'Optimization for 2 no. of parameter
Dim max As Single, s1 As Integer, s2 As Integer, p1 As Integer, p2 As Integer, opt1 As Single, opt2 As Single, count As Integer
ReDim arr(range("p1_start") To range("p1_end"), range("p2_start") To range("p2_end")) As Integer
StartTime = Timer 'Record starting time
Application.ScreenUpdating = False
max = -100: opt1 = 0: opt2 = 0: count = 0
s1 = Application.max((UBound(arr, 1) - LBound(arr, 1)) \ range("p1_step"), 1)
s2 = Application.max((UBound(arr, 2) - LBound(arr, 2)) \ range("p2_step"), 1)
If UBound(arr, 1) = LBound(arr, 1) Then p1 = LBound(arr, 1): GoTo p2_loop Else 'for constant parameter1
For p1 = LBound(arr, 1) To UBound(arr, 1) Step s1
p2_loop:
If UBound(arr, 2) = LBound(arr, 2) Then p2 = LBound(arr, 2): GoTo run_result Else 'for constant parameter2
For p2 = LBound(arr, 2) To UBound(arr, 2) Step s2
run_result:
If p1 < p2 Then
range("p1_optz") = p1
range("p2_optz") = p2
count = count + 1
If range("result") >= max Then
max = range("result")
opt1 = p1
opt2 = p2
End If
End If
If UBound(arr, 2) = LBound(arr, 2) Then GoTo p1_loop_type2 Else
Next p2
p1_loop_type2:
If UBound(arr, 1) = LBound(arr, 1) Then GoTo end_case Else
Next p1
end_case:
Application.ScreenUpdating = True
'record optimizated parapmeters and result
range("B2") = opt1
range("C2") = opt2
range("D2") = count
range("E2") = Format(Timer - StartTime, "00.00") & " seconds"
End Sub

作者: alee001   发布时间: 2013-09-21

作者: a8d7e8   发布时间: 2013-09-21

作者: alee001   发布时间: 2013-09-21

作者: a8d7e8   发布时间: 2013-09-21

引用:原帖由 alee001 於 2013-8-29 11:34 PM 发表
Solver cannot let parameter $C$3>$C$2 or $C$3$C$2

Besides running solvers by 2 times, have another method like this:
1. Define a cell, say C6 as IF(OR($C$3>$C$2, $C$3<>$C$2),1,0)
2. Then in solver, add constraint: $C$6=1

作者: ricyik   发布时间: 2013-09-21

ricyik师兄好提议
不过有时用SOLVER解非线性题目时，每次求解会出现不同正确的答案?
(依我两个参数最佳化为例子，可能出现p1及p2的答案分别为8,20; 8,21; 9,20; 9,21，它们同时都是解的最大值，但SOLVER有时会得出其中一组为答案，所以变相没有绝对答案 )

作者: alee001   发布时间: 2013-09-21

作者: ricyik   发布时间: 2013-09-21

作者: alee001   发布时间: 2013-09-21

作者: ricyik   发布时间: 2013-09-21

I had ashamed to basice VBA only and more tired if learning other lauguages.

I known some effect to a limited extent on VBA, I had trying open seveal Excel to run VBA so than multi-searching to divide into group of parameters....may be only method.

作者: alee001   发布时间: 2013-09-21