temp4n(1，ll)=stockdata(k).id
temp4n(2，ll)=dist(stockdata(k).ch，temp4w)
ll=ll+1
Else
End If
Next k
'填補最近距離矩陣相應位置的元素
'產生搜尋數組
Dim temp()
ReDim temp(UBound(temp4n，2))
Form=1 To UBound(temp4n，2)
temp(m)=temp4n(2，m)
Next m
'搜索id
id=smin_id(temp)
'矩陣賦值
nearby(i，j)=temp4n(1，id)
If temp4n(1，id) <> "" Then
counter=counter+1
ReDim Preserve flvec(counter)
flvec(counter)=temp4n(1，id)
Else
End If
Next j
Next i
'向“數據”頁寫入數據
Sheets("數據").Select
Cells.Select
Selection.Delete
sn4sj=Sheets("temp").Range("XFD1").End(xlToLeft).Column
hn4sj=Sheets("temp").Range("A1048576").End(xlUp).Row
Fori=1 To hn4sj
Sheets("數據").Cells(i，1)=Sheets("temp").Cells(i，1)
Sheets("數據").Cells(i，UBound(flvec)+2)=Sheets("temp").Cells(i，2)
Next i
Fori=LBound(flvec) To UBound(flvec)
Forj=1 To sn4sj
If flvec(i)=Sheets("temp").Cells(1，j) Then
Fork=1 To hn4sj
Sheets("數據").Cells(k，i+1)=Sheets("temp").Cells(k，j)
Next k
Exit For
Else
End If
Next j
Next i
Sheets("處理").Select
'
'
'
''向“gridal”頁寫入數據
'Sheets("gridal").Select
'Cells.Select
'Selection.Delete
'
'Fori=1 To UBound(finalout)
'Sheets("gridal").Cells(1，i)=finalout(i)
'Forj=1 To 300
'If Sheets("等級集群").Cells(1，j)=finalout(i) Then
'Sheets("gridal").Cells(2，i)=Sheets("等級集群").Cells(2，j)
'Sheets("gridal").Cells(3，i)=Sheets("等級集群").Cells(3，j)
'Else
'
'End If
'Next j
'Next i
End Sub
Option Base 1
Sub weightarrange() '/ beta_target As Variant，LR As Variant
Application.Calculation=xlManual
Rows("3:6").Select
Selection.ClearContents
Columns("I:XFD").Select
Selection.ClearContents
Cells(10，4).Select
hn=Sheets("數據").Range("A1048576").End(xlUp).Row
sn=Sheets("數據").Range("XFD1").End(xlToLeft).Column
Sheets("處理").Cells(1，1)="目標alpha"
Sheets("處理").Cells(1，3)="目標beta"
Sheets("處理").Cells(1，5)="杠杆比率"
Sheets("處理").Cells(1，7)="資金總額"
Sheets("處理").Cells(2，1)="實際alpha"
Sheets("處理").Cells(2，3)="實際beta"
Sheets("處理").Cells(2，5)="跟蹤誤差"
Sheets("處理").Cells(2，7)="總和"
Sheets("處理").Cells(5，1)="配置"
Sheets("處理").Cells(6，1)="絕對配置"
Randomize
Fori=2 To sn-1
Sheets("處理").Cells(3，i)=Sheets("數據").Cells(1，i)
Sheets("處理").Cells(4，i)=Sheets("數據").Cells(2，i)
Sheets("處理").Cells(5，i)=2*Rnd-1
Sheets("處理").Cells(6，i)="=IF(" & NumToChr(i) & "5="""","""",ABS(" & NumToChr(i) & "5))"
sum4w=Abs(Sheets("處理").Cells(5，i))+sum4w
Next i
Sheets("處理").Cells(2，8)="=SUM(" & NumToChr(2) & "6:" & NumToChr(sn-1) & "6)"
Dim weight()
ReDim weight(sn-2)
Dim returnarr() As Variant
'ReDim weight(sn-2) & Sheets("處理").Cells(5，i) & "," ",ABS(B11))"
returnarr()=Range(Sheets("數據").Cells(4，2)，Sheets("數據").Cells(hn，sn-1))
Fori=1 To sn-2
weight(i)=Sheets("處理").Cells(5，1+i)/sum4w
Next i
Sheets("處理").Cells(2，6)="=track_error4r(" & NumToChr(2) & "5:" & NumToChr(sn-1) & "5)"
Application.Calculation=xlAutomatic
'Cells(10，5)="=track_error4r(" & NumToChr(2) & "5:" & NumToChr(sn-1) & "5)"
End Sub
Function ror_arr(weight As Variant，base As Variant) As Variant
Dim temp()
ReDim temp(UBound(base))
Fori=LBound(base) To UBound(base)
temp_var=0
Forj=LBound(weight) To UBound(weight)
temp_var=temp_var+weight(j)*base(i，j)
Next j
temp(i)=temp_var
Next i
ror_arr=temp
End Function
Function track_error(a As Variant，b As Variant) As Variant
sum_error=0
Fori=LBound(a) To UBound(a)
sum_error=sum_error+Application.WorksheetFunction.Power(a(i)-b(i)，2)
Next i
track_error=sum_error
End Function
Function cal_rorptar(ror As Variant，alpha As Variant，beta As Variant) As Variant
Dim temp()
ReDim temp(UBound(ror))
Fori=LBound(ror) To UBound(ror)
temp(i)=alpha+beta*ror(i)
Next i
cal_rorptar=temp
End Function
Function NumToChr(ByVal PureNum As Integer) As String
If PureNum Mod 26=0 Then
NumToChr=VBA.IIf(PureNum \\ 26=1，""，VBA.Chr(PureNum \\ 26+63)) & "Z"
Else
NumToChr=VBA.IIf(PureNum \\ 26=0，""，Chr(PureNum \\ 26+64)) & Chr(PureNum Mod 26+64)
End If
End Function
Function track_error4r(rg As Variant) As Variant
hn=Sheets("數據").Range("A1048576").End(xlUp).Row
sn=Sheets("數據").Range("XFD1").End(xlToLeft).Column
temp=rg
Dim weight()
ReDim weight(UBound(temp，2))
Fori=LBound(temp，2) To UBound(temp，2)
weight(i)=temp(1，i)
Next i
alpha=Sheets("處理").Cells(1，2)
beta=Sheets("處理").Cells(1，4)
Dim returnarr() As Variant
returnarr()=Range(Sheets("數據").Cells(4，2)，Sheets("數據").Cells(hn，sn-1))
temp=0
Fori=1 To sn-2
temp=temp+Abs(weight(i))
Next i
Fori=1 To sn-2
weight(i)=weight(i)/temp
Next i
Dim temp_index()
ReDim temp_index(UBound(returnarr))
Fori=LBound(returnarr) To UBound(returnarr)
temp_index(i)=Sheets("數據").Cells(i+3，sn)
Next i
temp_p=ror_arr(weight，returnarr)
temp_t=cal_rorptar(temp_index，alpha，beta)
track_error4r=track_error(temp_p，temp_t)
End Function
Sub optm()
Worksheets("處理").Activate
'hn=Sheets("temp").Range("A1048576").End(xlUp).Row
snn=Sheets("處理").Range("XFD4").End(xlToLeft).Column
SolverOptions MaxTime:=100，Iterations:=10000，Precision:=0.000001，AssumeLinear _
:=False，StepThru:=False，Estimates:=1，Derivatives:=1，SearchOption:=1，_
IntTolerance:=5，Scaling:=False，Convergence:=0.0001，AssumeNonNeg:=False
SolverOk SetCell:="$F$2"，MaxMinVal:=2，ValueOf:="0"，ByChange:="$B$5:$" & NumToChr(snn) & "$5"
SolverAdd CellRef:="$H$2"，Relation:=2，FormulaText:="$H$1*$F$1"
SolverSolve userfinish:=True
hn=Sheets("數據").Range("A1048576").End(xlUp).Row
sn=Sheets("數據").Range("XFD1").End(xlToLeft).Column
If sn <=8 Then
psn=8
Else
psn=sn
End If
Dim weight()
ReDim weight(sn-2)
Dim returnarr() As Variant
Fori=2 To sn-1
sum4w=Abs(Sheets("處理").Cells(5，i))+sum4w
Next i
'ReDim weight(sn-2) & Sheets("處理").Cells(5，i) & "," ",ABS(B11))"
returnarr()=Range(Sheets("數據").Cells(4，2)，Sheets("數據").Cells(hn，sn-1))
Fori=1 To sn-2
weight(i)=Sheets("處理").Cells(5，1+i)/sum4w
Next i
Fori=1 To hn
Sheets("處理").Cells(i，psn+2)=Sheets("數據").Cells(i，1)
Sheets("處理").Cells(i，psn+3)=Sheets("數據").Cells(i，sn)
Next i
sum4d=0
Sheets("處理").Cells(1，psn+4)="組合實際收益率"
Dim temp_index()
ReDim temp_index(UBound(returnarr))
Fori=1 To hn-3
sum4p=0
Forj=1 To sn-2
sum4p=sum4p+weight(j)*returnarr(i，j)
Next j
Sheets("處理").Cells(i+3，psn+4)=sum4p
Next i
Sheets("處理").Cells(2，4)=WorksheetFunction.Slope(Range(Sheets("處理").Cells(4，psn+4)，Sheets("處理").Cells(hn，psn+4))，Range(Sheets("處理").Cells(4，psn+3)，Sheets("處理").Cells(hn，psn+3)))
Sheets("處理").Cells(2，2)=WorksheetFunction.Average(Range(Sheets("處理").Cells(4，psn+4)，Sheets("處理").Cells(hn，psn+4)))-Sheets("處理").Cells(2，2)*WorksheetFunction.Average(Range(Sheets("處理").Cells(4，psn+3)，Sheets("處理").Cells(hn，psn+3)))
End Sub
Sub zuotu()
hn=Sheets("數據").Range("A1048576").End(xlUp).Row
sn=Sheets("數據").Range("XFD1").End(xlToLeft).Column
If sn <=8 Then
psn=8
Else
psn=sn
End If
Sheets("處理").Cells(10，10).Select
'Range(Sheets("處理").Cells(4，sn+3)，Sheets("處理").Cells(hn，sn+4)).Select
ActiveSheet.Shapes.AddChart(xlXYScatter，200，150，300，150).Select
ActiveChart.SetSourceData Source:=Range("'處理'!$" & NumToChr(psn+3) & "$4:$" & NumToChr(psn+4) & "$" & hn)
End Sub