运算量太大,每次数据一多就当机
Public Sub TR(ByRef RR() As Double, ByRef RRR() As Double)
    Dim N As Integer, l As Integer
    Dim i As Integer, j As Integer, k As Integer
    Dim i1 As Integer, j1 As Integer
    Dim dMax As Double
    N = UBound(RR, 1)
    ReDim DMin(0 To N) As Double
    
    l = 0
    mulnum = 1
20:
     ReDim RRR(r, r) As Double
     ReDim DMin(0 To N) As Double
     mulnum = mulnum * 2
     l = l + 1
     If l > 20 Then
         MsgBox "已进行20次自乘,仍然没有获得传递性", vbCritical, "错误"
        Exit Sub
    End If
    For i = 0 To N
        For j = 0 To N
            For k = 0 To N
                
                If RR(i, k) <= RR(k, j) Then
                    DMin(k) = RR(i, k)
                Else
                DMin(k) = RR(k, j)
                End If
            Next
            dMax = DMin(0)              '模糊矩阵的乘法,取小取大
            For k = 1 To N
                If DMin(k) > dMax Then dMax = DMin(k)
                
            Next
               RRR(i, j) = dMax
        Next
        
    Next
    Erase DMin
      
    For i = 0 To N
        For j = 0 To N
            '判断是否式模糊等价矩阵,若非则继续做
            If RR(i, j) <> RRR(i, j) Then
                For i1 = 0 To N
                    For j1 = 0 To N
                        RR(i1, j1) = RRR(i1, j1)
                    Next
                Next
               Erase RRR
                GoTo 20
            End If
        Next
    Next
    
End Sub