Excel/VBA在物元分析法評(píng)估教學(xué)中的應(yīng)用

摘要:物元分析是一種解決不相容問(wèn)題的分析方法，文中利用VBA(Visual Basic for Application)在Excel下編寫(xiě)宏程序，使用戶處理數(shù)據(jù)時(shí)徹底從手工操作中解放出來(lái)，最終達(dá)到物元分析法在Excel中實(shí)現(xiàn)“傻瓜”操作的目標(biāo)。

關(guān)鍵詞:物元分析;教學(xué);Excel;VBA

中圖分類號(hào):TP311文獻(xiàn)標(biāo)識(shí)碼:A文章編號(hào):1009-3044(2010)01-154-03

Excel/VBA Application on Teaching of Evaluation with Matter Element Analysis

LI Chao

(School of Statistics and Applied Mathematics， Anhui University of Finance and Economics， Bengbu 233030， China)

Abstract: Matter element analysis is an analytical method which can resolve incompatible problem. In this article， an easy-to-implement solution to matter element analysis by VBA in Microsoft Excel is provided， which makes users be completely free from manual operation.

Key words: matter element analysis; Teaching; Excel; VBA

1 概述

物元分析是研究在某些條件下，用通常的方法無(wú)法達(dá)到預(yù)期目標(biāo)的不相容問(wèn)題的分析方法。目前，使用物元分析方法進(jìn)行數(shù)據(jù)處理需要在Excel軟件中運(yùn)用函數(shù)、公式等進(jìn)行人工、半人工操作。在數(shù)據(jù)量龐大的情況下，這種按步驟一步步的手工處理過(guò)程容易出現(xiàn)輸入錯(cuò)誤，而且執(zhí)行的任務(wù)多為重復(fù)性工作，處理過(guò)程較為復(fù)雜，從而降低了物元分析方法的可行性、準(zhǔn)確性。因此，在使用物元分析方法處理數(shù)據(jù)時(shí)，為了簡(jiǎn)化程序化計(jì)算量，使用戶徹底從手工操作中解放出來(lái)，我們?cè)噲D在運(yùn)用最廣泛的辦公軟件Excel下運(yùn)用應(yīng)用程序開(kāi)發(fā)語(yǔ)言VBA進(jìn)行自動(dòng)化處理，對(duì)于普及和推廣物元分析方法具有極其重要的意義。

2 物元分析

物元分析綜合評(píng)價(jià)模型的方法是:針對(duì)待評(píng)價(jià)區(qū)域N，搜集各有關(guān)評(píng)價(jià)指標(biāo)Ck(k=1，2，…，p)的數(shù)據(jù)Vk(k=1，2，…，p)，并根據(jù)需要將各指標(biāo)劃分為若干級(jí)j(j=1，2，…，m);由數(shù)據(jù)庫(kù)或?qū)＜乙庖?jiàn)給出每個(gè)指標(biāo)各等級(jí)的數(shù)據(jù)范圍Vjk(Vjk=[ajk，bjk])，再將待評(píng)區(qū)域的有關(guān)指標(biāo)代入各等級(jí)的集合中進(jìn)行多指標(biāo)評(píng)價(jià);最后將評(píng)價(jià)結(jié)果按它與各等級(jí)集合的關(guān)聯(lián)度大小進(jìn)行比較，關(guān)聯(lián)度越大，它與某等級(jí)集合的符合程度就越佳。具體評(píng)價(jià)步驟詳見(jiàn)文獻(xiàn)1。

3 物元分析法評(píng)估的Excel/ VBA程序

易于用計(jì)算機(jī)規(guī)范化是物元分析方法的一個(gè)顯著特點(diǎn)，根據(jù)物元分析的理論，使用Microsoft Excel軟件的VBA語(yǔ)言，編寫(xiě)物元分析的Excel宏程序算法。此程序可以一步實(shí)現(xiàn)物元分析法評(píng)估的全過(guò)程，并給出最終結(jié)果，而且此程序具有一定的通用性，只要進(jìn)行此類的物元分析評(píng)估(聚類)，記錄、指標(biāo)個(gè)數(shù)和最大聚類個(gè)數(shù)都沒(méi)有限制，尤其是聚類個(gè)數(shù)，可以根據(jù)實(shí)際情況有用戶自由輸入確定。VBA在Excel下編寫(xiě)宏程序?qū)崿F(xiàn)物元分析，其代碼如下(可將下面代碼輸入Excel Visual Basic 編輯器中的代碼編輯窗口即可運(yùn)行，如因排版緣故，一條語(yǔ)句可能顯示在幾行中，在Excel Visual Basic 代碼編輯器窗口應(yīng)為同一行):

'限于程序的易讀性與篇幅，本程序中未處理異常，本程序具有一定的通用性。

'變量與數(shù)組的聲明

Option Base 1

Dim shuju()， u()， shuju_min()， shuju_max()， shuju_average() As Single

Dim para_a()， para_b()， para_k()， weight()， weight_sum As Single

Dim djjx()， djbz()， djbzkz()， dj_average()， djgld()， djz()， djlb() As Single

Dim temp As Variant '定義臨時(shí)變量

Dim sjqy As Variant '需要進(jìn)行物元分析的數(shù)據(jù)所在的區(qū)域

Dim wyfxcommandbar As CommandBar

Dim wyfxcmdbar As CommandBarButton

Public n， m， k

'退出時(shí)刪除自定義工具欄

Private Sub Workbook_BeforeClose(Cancel As Boolean)

Application.CommandBars(\"物元分析\").Delete

End Sub

'打開(kāi)時(shí)添加自定義工具欄

Private Sub Workbook_Open()

On Error Resume Next

Application.CommandBars(\"物元\").Delete

Set wyfxcommandbar = Application.CommandBars.Add(\"物元分析\")

With wyfxcommandbar.Controls

Set wyfxcmdbar = .Add(msoControlButton)

With wyfxcmdbar

.Style = msoButtonIconAndCaption

.Caption = \"物元分析\"

.OnAction = \"thisworkbook.wyfx\"

End With

wyfxcommandbar.Visible = True

End With

End Sub

Private Sub wyfx()

On Error Resume Next

'讀取用戶輸入的數(shù)據(jù)所在的區(qū)域，默認(rèn)范圍為用戶選擇的表格數(shù)據(jù)區(qū)域

sjqy = InputBox(\"請(qǐng)輸入數(shù)據(jù)在Excel中的起始結(jié)束位置\" vbCrLf vbCrLf \"※一定要正確輸入，數(shù)據(jù)范圍不包括標(biāo)志\"， \"輸入范圍\"， ActiveWindow.RangeSelection.AddressLocal(0， 0))

If Len(Trim(sjqy)) = 0 Then

MsgBox \"沒(méi)有輸入正確范圍，請(qǐng)重新執(zhí)行程序輸入正確的數(shù)據(jù)范圍!\"， ， \"沒(méi)有輸入\"

Else

k = InputBox(\"請(qǐng)輸入最大聚類個(gè)數(shù)\" vbCrLf vbCrLf \"※輸入一個(gè)整數(shù)值，如 4 \"， \"輸入聚類個(gè)數(shù)\"， 4)

n = range(sjqy).Rows.Count

m = range(sjqy).Columns.Count

ReDim shuju(n， m)， u(n， m)， julei(n)， para_a(m)， para_b(m)， para_k(m)， shuju_min(m)， shuju_max(m)， shuju_average(m)

ReDim djjx(k)， djbz(k， m)， djbzkz(k + 2， m)， dj_average(m)， djgld(k， n， m)， djz(n， k)， djlb(n)， weight(m)

'將數(shù)據(jù)保存到數(shù)組中

For j = 1 To m

For i = 1 To n

shuju(i， j) = ActiveSheet.range(sjqy).Cells(i， j)

Next

Next

'先計(jì)算每個(gè)指標(biāo)的最大值、最小值和平均值，再計(jì)算參數(shù)a、b和k的值

For j = 1 To m

shuju_min(j) = shuju(1， j)

shuju_max(j) = shuju(1， j)

shuju_average(j) = 0

For i = 1 To n

If shuju_max(j) < shuju(i， j) Then shuju_max(j) = shuju(i， j)

If shuju_min(j) > shuju(i， j) Then shuju_min(j) = shuju(i， j)

shuju_average(j) = shuju_average(j) + shuju(i， j)

Next

shuju_average(j) = shuju_average(j)/n

para_b(j) = 1/(shuju_max(j) - shuju_min(j))

para_a(j) = 1-para_b(j)*shuju_max(j)

para_k(j) = Application.WorksheetFunction.Log(0.5， para_a(j)+para_b(j)*shuju_average(j))

Next

'計(jì)算隸屬函數(shù)u(x)值

For j = 1 To m

For i = 1 To n

If shuju(i， j) = shuju_max(j) Then u(i， j) = 1

If shuju(i， j) = shuju_min(j) Then u(i， j) = 0

If shuju(i， j) > shuju_min(j) And shuju(i， j) < shuju_max(j) Then u(i， j) = (para_a(j) + para_b(j) * shuju(i， j)) ^ para_k(j)

Next

Next

'計(jì)算等級(jí)標(biāo)準(zhǔn)

djjx(1) = 1 / k

For i = 2 To k

djjx(i) = djjx(i - 1) + 1 / k

Next

For j = 1 To m

dj_average(j) = 0

For i = 1 To k

djbz(i， j) = (djjx(i) ^ (1 / para_k(j)) - para_a(j)) / para_b(j)

dj_average(j) = dj_average(j) + djbz(i， j)

Next

dj_average(j) = dj_average(j) / k

Next

For i = 1 To k + 2

For j = 1 To m

If i = 1 Then

djbzkz(i， j) = 0

ElseIf i = k + 2 Then

djbzkz(i， j) = 1.5 * djbz(k， j)

Else

djbzkz(i， j) = djbz(i - 1， j)

End If

Next

Next

'計(jì)算權(quán)重并標(biāo)準(zhǔn)化

weight_sum = 0

For j = 1 To m

weight(j) = shuju_average(j) / dj_average(j)

weight_sum = weight_sum + weight(j)

Next

For j = 1 To m

weight(j) = weight(j) / weight_sum

Next

'計(jì)算等級(jí)關(guān)聯(lián)度

For t = 1 To k

For i = 1 To n

For j = 1 To m

If shuju(i， j) = 0 And t = 1 Then

djgld(t， i， j) = 1

Else

If shuju(i， j) > djbzkz(t， j) And shuju(i， j) <= djbzkz(t + 1， j) Then

djgld(t， i， j) = -((Abs(shuju(i， j) - (djbzkz(t， j) + djbzkz(t + 1， j))/2) - (djbzkz(t + 1， j) - djbzkz(t， j))/2)/(djbzkz(t + 1， j) - djbzkz(t， j)))

Else

djgld(t， i， j) = (Abs(shuju(i， j) - (djbzkz(t， j) + djbzkz(t + 1， j))/2) - (djbzkz(t + 1， j) - djbzkz(t， j))/2)/((Abs(shuju(i， j) - djbzkz(t + 2， j)/2) - djbzkz(t + 2， j)/2)-(Abs(shuju(i， j) - (djbzkz(t， j) + djbzkz(t + 1， j))/2) - (djbzkz(t + 1， j) - djbzkz(t， j))/2))

End If

End If

Next

Next

Next

'加權(quán)計(jì)算各等級(jí)值并得出等級(jí)種類

For t = 1 To k

For i = 1 To n

djz(i， t) = 0

For j = 1 To m

djz(i， t) = djz(i， t) + djgld(t， i， j) * weight(j)

Next

Next

Next

For i = 1 To n

djlb(i) = 1

temp = djz(i， 1)

For t = 1 To k

If djz(i， t) > temp Then

temp = djz(i， t)

djlb(i) = t

End If

Next

Next

'結(jié)果在本工作薄中新建立的工作表中輸出

Worksheets.Add after:=Sheets(Application.Worksheets.Count)

Application.ActiveSheet.Name = \"物元分析結(jié)果輸出\"

Application.range(\"a1\").Value = \"記錄\"

Application.range(\"b1\").Value = \"聚類結(jié)果\"

For i = 2 To n + 1

Cells(i， 1).Value = \"Record\" Trim(Str(i - 1))

Cells(i， 2).Value = djlb(i - 1)

Next

End If

End Sub

4 結(jié)束語(yǔ)

物元分析是研究在某些條件下，用通常的方法無(wú)法達(dá)到預(yù)期目標(biāo)的不相容問(wèn)題的分析方法。其應(yīng)用前景非常廣闊，可將物元模型的方法應(yīng)用于評(píng)估問(wèn)題，例如，文獻(xiàn)1利用物元分析方法對(duì)我國(guó)洪災(zāi)損失進(jìn)行綜合評(píng)估，因?yàn)楹闈碁?zāi)害損失綜合評(píng)估也是一個(gè)較為復(fù)雜的問(wèn)題。根據(jù)事先確定的綜合評(píng)估指標(biāo)，對(duì)評(píng)估區(qū)域的指標(biāo)性狀數(shù)據(jù)用定量的數(shù)值表示，并通過(guò)關(guān)聯(lián)函數(shù)刻畫(huà)指標(biāo)與災(zāi)害等級(jí)的關(guān)聯(lián)程度，從而對(duì)各地區(qū)的洪澇災(zāi)害損失進(jìn)行評(píng)估，物元分析綜合評(píng)估方法能夠較為客觀地反映洪澇災(zāi)害損失的程度，實(shí)踐證明效果較為理想。

參考文獻(xiàn):

[1] 李超.基于物元分析的我國(guó)洪災(zāi)損失綜合評(píng)估[J].統(tǒng)計(jì)教育，2004(3):44-46.

[2] 蔡文.可拓學(xué)概述[J].系統(tǒng)工程理論與實(shí)踐，1998(1):76-84.

[3] 李超.灰色預(yù)測(cè):Excel/VBA編程輕松實(shí)現(xiàn)[J].統(tǒng)計(jì)與信息論壇，2004，19(3):72-75.

[4] 余華銀，李超.熵值法在Excel中的VBA實(shí)現(xiàn)[J].統(tǒng)計(jì)教育，2004(3):12-14.

[5] 柯健，李超.Excel單鍵實(shí)現(xiàn)Borda法組合評(píng)價(jià)[J].統(tǒng)計(jì)與信息論壇，2005，20(1):103-105.