gp_matrix_temp(ii，j)=gp_matrix(i，j)
Next j
ii=ii+1
End If
Next i
gp_merge=gp_matrix_temp
End Function
Function smin_id(vec As Variant) As Variant
temp=vec(LBound(vec))
temp4id=LBound(vec)
Fori=LBound(vec) To UBound(vec)
If vec(i) temp=vec(i)
temp4id=i
Else
End If
Next i
smin_id=temp4id
End Function
Function smin(vec As Variant) As Variant
temp=vec(LBound(vec))
Fori=LBound(vec) To UBound(vec)
If vec(i) temp=vec(i)
Else
End If
Next i
smin=temp
End Function
Function smin4m(matrix As Variant) As Variant
Dim pos(2)
temp=matrix(LBound(matrix)，LBound(matrix)+1)
pos(1)=LBound(matrix)
pos(2)=LBound(matrix)+1
Fori=LBound(matrix) To UBound(matrix)
Forj=LBound(matrix，2) To UBound(matrix，2)
If matrix(i，j) temp=matrix(i，j)
pos(1)=i
pos(2)=j
Else
End If
Next j
Next i
smin4m=pos
End Function
Function dist(a As Variant，b As Variant) As Variant
Dim temp()
ReDim temp(UBound(a))
Fori=LBound(a) To UBound(a)
temp(i)=a(i)-b(i)
Next i
temp_val=0
Fori=LBound(a) To UBound(a)
temp_val=temp_val+Application.WorksheetFunction.Power(temp(i)，2)
Next i
dist=Sqr(temp_val)
End Function
Option Base 1
Type stock
id As String
gp As Integer
ch() As Variant
End Type
Type charac
ch() As Variant
End Type
Sub gridal()
hn=Sheets("等級集群").Range("A1048576").End(xlUp).Row
sn=Sheets("等級集群").Range("XFD1").End(xlToLeft).Column
Dim stockdata() As stock'stock 向量數組
ReDim stockdata(sn)
'數據讀取
Fori=1 To sn
ReDim stockdata(i).ch(hn-1)
stockdata(i).id=Sheets("等級集群").Cells(1，i)
stockdata(i).gp=i
Forj=1 To hn-1
stockdata(i).ch(j)=Sheets("等級集群").Cells(j+1，i)
Next j
Next i
'用戶輸入alpha，beta分類，第一個自由度
Dim na As Integer
Dim nb As Integer
na=Int(CDbl(InputBox("分類數量"，"網格分類法alpha區間數量輸入")))
nb=Int(CDbl(InputBox("分類數量"，"網格分類法beta區間數量輸入")))
'給出最大最小beta與alpha
betamin=stockdata(1).ch(2)
betamax=stockdata(1).ch(2)
alphamin=stockdata(1).ch(1)
alphamax=stockdata(1).ch(1)
Fori=LBound(stockdata) To UBound(stockdata)
If stockdata(i).ch(2) > betamax Then
betamax=stockdata(i).ch(2)
End If
If stockdata(i).ch(2) betamin=stockdata(i).ch(2)
End If
If stockdata(i).ch(1) > alphamax Then
alphamax=stockdata(i).ch(1)
End If
If stockdata(i).ch(1) alphamin=stockdata(i).ch(1)
End If
Next i
disa=(alphamax-alphamin)/(na-1)
disb=(betamax-betamin)/(nb-1)
'產生端點數組
Dim alphaep()
ReDim alphaep(na+1)
Fori=1 To na+1
alphaep(i)=(alphamin-disa/2)+(i-1)*disa
Next i
Dim betaep()
ReDim betaep(nb+1)
Fori=1 To nb+1
betaep(i)=(betamin-disb/2)+(i-1)*disb
Next i
'產生重心數組
Dim alphawp()
ReDim alphawp(na)
Fori=1 To na
alphawp(i)=(alphaep(i)+alphaep(i+1))/2
Next i
Dim betawp()
ReDim betawp(nb)
Fori=1 To nb
betawp(i)=(betaep(i)+betaep(i+1))/2
Next i
'產生最近距離矩陣
Dim nearby()
ReDim nearby(na，nb)
Dim temp4n()
Dim temp4w()
Dim flvec()
counter=0
Fori=1 To na
Forj=1 To nb
ll=1
ReDim temp4w(2)
temp4w(1)=alphawp(i)
temp4w(2)=betawp(j)
ReDim temp4n(2，ll)
Fork=1 To UBound(stockdata)
If (stockdata(k).ch(1) > alphaep(i) And stockdata(k).ch(1) ReDim Preserve temp4n(2，ll)
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
Type stock
id As String
gp As Integer
ch() As Variant
End Type
Type charac
ch() As Variant
End Type
Sub gridal()
hn=Sheets("等級集群").Range("A1048576").End(xlUp).Row
sn=Sheets("等級集群").Range("XFD1").End(xlToLeft).Column
Dim stockdata() As stock'stock 向量數組
ReDim stockdata(sn)
'數據讀取
Fori=1 To sn
ReDim stockdata(i).ch(hn-1)
stockdata(i).id=Sheets("等級集群").Cells(1，i)
stockdata(i).gp=i
Forj=1 To hn-1
stockdata(i).ch(j)=Sheets("等級集群").Cells(j+1，i)
Next j
Next i
'用戶輸入alpha，beta分類，第一個自由度
Dim na As Integer
Dim nb As Integer
na=Int(CDbl(InputBox("分類數量"，"網格分類法alpha區間數量輸入")))
nb=Int(CDbl(InputBox("分類數量"，"網格分類法beta區間數量輸入")))
'給出最大最小beta與alpha
betamin=stockdata(1).ch(2)
betamax=stockdata(1).ch(2)
alphamin=stockdata(1).ch(1)
alphamax=stockdata(1).ch(1)
Fori=LBound(stockdata) To UBound(stockdata)
If stockdata(i).ch(2) > betamax Then
betamax=stockdata(i).ch(2)
End If
If stockdata(i).ch(2) betamin=stockdata(i).ch(2)
End If
If stockdata(i).ch(1) > alphamax Then
alphamax=stockdata(i).ch(1)
End If
If stockdata(i).ch(1) alphamin=stockdata(i).ch(1)
End If
Next i
disa=(alphamax-alphamin)/(na-1)
disb=(betamax-betamin)/(nb-1)
'產生端點數組
Dim alphaep()
ReDim alphaep(na+1)
Fori=1 To na+1
alphaep(i)=(alphamin-disa/2)+(i-1)*disa
Next i
Dim betaep()
ReDim betaep(nb+1)
Fori=1 To nb+1
betaep(i)=(betamin-disb/2)+(i-1)*disb
Next i
'產生重心數組
Dim alphawp()
ReDim alphawp(na)
Fori=1 To na
alphawp(i)=(alphaep(i)+alphaep(i+1))/2
Next i
Dim betawp()
ReDim betawp(nb)
Fori=1 To nb
betawp(i)=(betaep(i)+betaep(i+1))/2
Next i
'產生最近距離矩陣
Dim nearby()
ReDim nearby(na，nb)
Dim temp4n()
Dim temp4w()
Dim flvec()
counter=0
Fori=1 To na
Forj=1 To nb
ll=1
ReDim temp4w(2)
temp4w(1)=alphawp(i)
temp4w(2)=betawp(j)
ReDim temp4n(2，ll)
Fork=1 To UBound(stockdata)
If (stockdata(k).ch(1) > alphaep(i) And stockdata(k).ch(1) ReDim Preserve temp4n(2，ll)