关于VBA四参数中的自定义函数的问题

大学好我是新来

Option Base 1
Public Const PI = 3.14159265358979

'csqj()为坐标转换参数求解的自定义函数
Function csqj(zhq As Range, zhh As Range) As Variant
    Dim b(), bt(), l(), cs, bbtn, zhqi, zhhi, sc(4, 2)
    Dim X1!, y1!, x2!, y2!, i%, j%, k%
    sc(1, 1) = "△X(米)": sc(2, 1) = "△y(米)"
    sc(3, 1) = "旋转角a(秒）": sc(4, 1) = "尺度m"
   ' 统计公共点的个数
    i = 0
    For Each zhqi In zhq
        i = i + 1
    Next zhqi
    n = i
    If n = 2 Then  '当n=2时，只有一个已知公共点
        i = 0
        For Each zhqi In zhq
        i = i + 1
        If i = 1 Then
             X1 = zhqi.Value
         Else
              y1 = zhqi.Value
         End If
    Next zhqi
        i = 0
        For Each zhhi In zhh
        i = i + 1
        If i = 1 Then
            x2 = zhhi.Value
        Else
        y2 = zhhi.Value
        End If
        Next zhhi
         sc(1, 2) = x2 - X1
         sc(2, 2) = y2 - y1
         sc(3, 2) = 0
           sc(4, 2) = 1#
    Else
    ReDim b(n, 4): ReDim bt(4, n): ReDim l(n)
'组成B数组
    i = 0
    k = 1
For Each zhqi In zhq
    i = i + 1
    If (i + 2) Mod 2 <> 0 Then
    b(k, i + 2) = zhqi.Value
    b(k + 1, 4) = zhqi.Value
    Else
    b(k, i + 2) = -zhqi.Value
    b(k + 1, 3) = zhqi.Value
    End If
    If i Mod 2 = 0 Then
    k = k + 2
    i = 0
    End If
Next zhqi
For i = 1 To n
    For j = 1 To 4
        If j = 1 And i Mod 2 <> 0 Then
         b(i, j) = 1
    ElseIf j = 1 And i Mod 2 = 0 Then
         b(i, j) = 0
    ElseIf j = 2 And i Mod 2 <> 0 Then
          b(i, j) = 0
    ElseIf j = 2 And i Mod 2 = 0 Then
          b(i, j) = 1
End If
Next j
Next i
'组成B数组
    i = 0
For Each zhhi In zhh
    i = i + 1
    l(i) = zhhi.Value
     Next zhhi
       bt = Application.WorksheetFunction.Transpose(b)
       bbtn = Application.WorksheetFunction.MInverse(Application.WorksheetFunction.MMult(bt, b))
        cs = Application.WorksheetFunction.MMult(Application.WorksheetFunction.MMult(bbtn, bt), Application.WorksheetFunction.Transpose(1))
            For i = 1 To 4
            sc(i, 2) = cs(i, 1)
            Next i
                sc(3, 2) = Application.WorksheetFunction.Atan2(sc(3, 2), sc(4, 2))
                If sc(3, 2) < 0 Then
                    sc(3, 2) = sc(3, 2) + 2 * PI
                End If
                sc(4, 2) = sc(4, 2) / Sin(sc(3, 2))
                sc(3, 2) = sc(3, 2) * 180 / PI * 3600
                End If
            csqj = sc
End Function

'zbzh( )为坐标转换自定义函数
Function zbzh(yzb As Range, scs As Range) As Variant                   ’这个位置会出错。。结果也没有
Dim b(2, 4), cs(4), bbtn, yzbi, scsi
Dim a#, i%, k%
'组成B数组
    i = 0
    k = 1
    For Each yzbi In yzb
    i = i + 1
    If (i + 2) Mod 2 <> 0 Then
        b(k, i + 2) = yzbi.Value
        b(k + 1, 4) = yzbi.Value
    Else
        b(k, i + 2) = yzbi.Value
        b(k + 1, 3) = yzbi.Value
End If
    Next yzbi
     b(1, 1) = 1: b(1, 2) = 0
     b(2, 1) = 0: b(2, 2) = 1
     i = 0
    For Each scsi In scs
        i = i + 1
        cs(i) = scsi.Value
    Next scsi
        a = cs(3) / 3600 / 180 * PI
        cs(3) = cs(4) * Cos(a)
        cs(4) = cs(4) * Sin(a)
    zbzh = Application.WorksheetFunction.MMult(b.Application.WorksheetFunction.Transpose(cs))
    zbzh = Application.WorksheetFunction.Transpose(zbzh)

End Function

大学好我是新来

https://www.doc88.com/p-1486197171986.html 原文代码。