三角模糊数运算.frm

应用模糊加权最小二乘法排序

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   8715
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   11130
   LinkTopic       =   "Form1"
   ScaleHeight     =   8715
   ScaleWidth      =   11130
   StartUpPosition =   3  '窗口缺省
   Begin VB.TextBox Text1 
      Height          =   495
      Left            =   1680
      TabIndex        =   4
      Text            =   "Text1"
      Top             =   1920
      Width           =   1575
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   495
      Left            =   4320
      TabIndex        =   3
      Top             =   840
      Width           =   1215
   End
   Begin VB.TextBox expnum 
      Height          =   375
      Left            =   1440
      TabIndex        =   0
      Text            =   "Text1"
      Top             =   840
      Width           =   1455
   End
   Begin VB.Label Label2 
      Caption         =   "Label2"
      Height          =   375
      Left            =   3240
      TabIndex        =   2
      Top             =   840
      Width           =   855
   End
   Begin VB.Label label1 
      Caption         =   "专家人数"
      Height          =   375
      Left            =   240
      TabIndex        =   1
      Top             =   840
      Width           =   975
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
Form2.Show

End Sub

Private Sub Form_Load()
Dim q(3) As Double
Dim t(5, 5, 3) As Double
Dim r(5, 5, 3) As Double
Dim s(5, 5, 3) As Double
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim n As Integer
Dim prot As Double
Dim pror As Double
Dim prots(5) As Double
Dim prorss As Double

Dim protss As Double
Dim l(5) As Double
Dim m(5) As Double
Dim u(5) As Double
Dim prors(5) As Double
Dim pross(5) As Double
Dim prosss As Double



Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
prot = 1
pror = 1
n = 8
For i = 1 To 5
  prots(i) = 1
  prors(i) = 1
  pross(i) = 1
Next i


'设置excel编程对象
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = False
Set xlBook = xlApp.Workbooks.Open(App.Path & "\Book1.xls")
Set xlSheet = xlBook.Worksheets(1)

'设置矩阵斜对角的值
 For i = 1 To 5
    For k = 1 To 3
      r(i, i, k) = 1
      s(i, i, k) = 1
      t(i, i, k) = 1
    Next k
 Next i
 '设置其他数值
 For i = 2 To 5
  For j = 1 To i - 1
   For k = 1 To 3
   r(i, j, k) = xlSheet.Cells(k + 3 * (i - 2), 1 + 3 * (j - 1))
   s(i, j, k) = xlSheet.Cells(k + 3 * (i - 2), 2 + 3 * (j - 1))
   t(i, j, k) = xlSheet.Cells(k + 3 * (i - 2), 3 + 3 * (j - 1))
   Next k
  Next j
 Next i

For i = 2 To 5
  For j = 1 To i - 1
   For k = 1 To 3
   r(j, i, k) = 1 / t(i, j, k)
   s(j, i, k) = 1 / s(i, j, k)
   t(j, i, k) = 1 / r(i, j, k)
   Next k
  Next j
 Next i
 
 '设置q值
 q(1) = 1 / 3
 q(2) = 1 / 3
 q(3) = 1 / 3
'求prot
For i = 1 To 5
   For j = 1 To 5
     For k = 1 To 3
     prot = prot * (t(i, j, k) ^ q(k))
     Next k
   Next j
 Next i
 prot = (prot ^ ((5 ^ (-2))))
 '求pror
 For i = 1 To 5
   For j = 1 To 5
     For k = 1 To 3
     pror = pror * (r(i, j, k) ^ q(k))
     Next k
   Next j
 Next i
 pror = (pror ^ ((5 ^ (-2))))
'求sumprot
 For i = 1 To 5
   For j = 1 To 5
     For k = 1 To 3
     prots(i) = prots(i) * (t(i, j, k) ^ q(k))
     Next k
   Next j
   protss = protss + (prots(i) ^ (1 / 5))
 Next i
 '求sumpror
 For i = 1 To 5
   For j = 1 To 5
     For k = 1 To 3
     prors(i) = prors(i) * (r(i, j, k) ^ q(k))
     Next k
   Next j
   prorss = prorss + (prors(i) ^ (1 / 5))
 Next i
 '求sumpros
 For i = 1 To 5
   For j = 1 To 5
     For k = 1 To 3
     pross(i) = pross(i) * (s(i, j, k) ^ q(k))
     Next k
   Next j
   prosss = prosss + (pross(i) ^ (1 / 5))
 Next i
 '求l值
 For i = 1 To 5
   l(i) = (prot / protss) * (prors(i) ^ (1 / 5))
   m(i) = (1 / prosss) * (pross(i) ^ (1 / 5))
   u(i) = (pror / prorss) * (prots(i) ^ (1 / 5))
 Next i
'求u值

Text1.Text = m(5)
   'expnum.Text = prot
     
 



End Sub