【Access自定义函数】散度函数

时　间:2021-08-07 09:33:06
作　者:麥田   ID：11  城市：上海  QQ：3002789054
摘　要:【Access自定义函数】散度函数。
正　文:

散度函数:

例如：3，7，18，25，30

第一步先分别求出第个数3与其他4个数的差绝对值

Arr(1)=Abs(7-3)=4

Arr(2)=Abs(18-3)=15

Arr(3)=Abs(25-3)=22

Arr(4)=Abs(30-3)=27

求出arr（1），arr（2），arr（3），arr（4）的最小值arr(1)=min(4,15,22,27)=4

第二步先分别求出第个数7与其他4个数的差绝对值

Arr(1)=Abs(3-7)=4

Arr(2)=Abs(18-7)=11

Arr(3)=Abs(25-7)=18

Arr(4)=Abs(30-7)=23

求出arr（1），arr（2），arr（3），arr（4）的最小值arr(1)=min(4,11,18,23)=4

第三步先分别求出第个数18与其他4个数的差绝对值

Arr(1)=Abs(3-18)=15

Arr(2)=Abs(7-18)=11

Arr(3)=Abs(25-18)=7

Arr(4)=Abs(30-18)=12

求出arr（1），arr（2），arr（3），arr（4）的最小值arr(1)=min(15,11,7,12)=7

第四步先分别求出第个数25与其他4个数的差绝对值

Arr(1)=Abs(3-25)=23

Arr(2)=Abs(7-25)=18

Arr(3)=Abs(18-25)=7

Arr(4)=Abs(30-25)=5

求出arr（1），arr（2），arr（3），arr（4）的最小值arr(1)=min(23,18,7,5)=5

第五步先分别求出第个数30与其他4个数的差绝对值

Arr(1)=Abs(3-30)=27

Arr(2)=Abs(7-30)=23

Arr(3)=Abs(18-30)=12

Arr(4)=Abs(25-30)=5

求出arr（1），arr（2），arr（3），arr（4）的最小值arr(1)=min(27,23,12,5)=5

求出第一步的4，第二步的4，第三步的7，第四步的5，第五步的5的最大值=max(4,4,7,5,5)=7

Sandu=7

'求散度，可传递3-6个数字，至少3个数字，后面数字不传递的话，可以为0 或省略

Public Function sandu(lngNum1 As Long, lngNum2 As Long, lngNum3 As Long, Optional lngNum4 As Long, Optional lngNum5 As Long, Optional lngNum6 As Long) As Long
   Dim arr(5) As Long  '变量数组，用来保存传递过来的数字
   Dim rtn(5) As Long  '变量数组，用来保存计算的最小值

   Dim lngCnt As Long  '有值的个数
   Dim lngMin As Long  '最小值
   Dim lngMax As Long  '最大值

   Dim stepMin()    As Long  '动态数组
   Dim groupArray() As Long  '动态数组
   Dim groupI        As Integer
   Dim lngI         As Integer
   
   '逐个判断有否值传递过来
   If lngNum1 > 0 Then
      arr(0) = lngNum1
      lngCnt = 1
   End If
   
   If lngNum2 > 0 Then
      arr(1) = lngNum2
      lngCnt = 2
   End If
  
   If lngNum3 > 0 Then
      arr(2) = lngNum3
      lngCnt = 3
   End If
    
    If lngNum4 > 0 Then
      arr(3) = lngNum4
      lngCnt = 4
   End If
     
   If lngNum5 > 0 Then
      arr(4) = lngNum5
      lngCnt = 5
   End If
       
    If lngNum6 > 0 Then
      arr(5) = lngNum6
      lngCnt = 6
   End If
   
   Dim i As Long
   Dim j As Long
   
   ReDim groupArray(lngCnt - 1)
   ReDim stepMin(lngCnt - 1)
   '循环，将其它与自己相减，取绝对值，并取最小值
   
   '返回结果
    For i = 0 To lngCnt - 1
        'lngMax = -1
        groupI = 0
        For j = 0 To lngCnt - 1
            rtn(i) = 99999
            If i <> j Then
                If rtn(i) > Abs(arr(j) - arr(i)) Then
                    
                    'rtn(i) = Abs(arr(j) - arr(i))
                    groupArray(groupI) = Abs(arr(j) - arr(i))
                    'Debug.Print groupArray(groupI)
                    
                    groupI = groupI + 1
                    
                    'Debug.Print arr(j) & "-" & arr(i) & "=" & rtn(i); "-" & i
                End If
            End If
        Next

        For lngI = 0 To UBound(groupArray) - 1
            If lngI = 0 Then lngMin = groupArray(0)
            If lngMin < groupArray(lngI) Then
                lngMin = lngMin
            Else
                lngMin = groupArray(lngI)
            End If
        Next
        'Debug.Print lngMin
        stepMin(i) = lngMin
    Next
    
    '最后一步求最大值
    For lngI = 0 To UBound(stepMin)
        'Debug.Print stepMin(lngI)
        If lngI = 0 Then lngMax = stepMin(0)
        If lngMax <= stepMin(lngI) Then
            lngMax = stepMin(lngI)
        Else
            lngMax = lngMax
        End If
    Next
    sandu = lngMax
End Function