将数组作为函数输入VBA传递

时间:2015-04-13 15:15:56

标签: arrays vba input

经过一些试验和研究,我无法弄清楚如何将数组作为函数的输入传递。

这是我的代码:

Function read_coordinates()
'''This function reads the coordinates (X,Y) of the machines in the sheet !layout and stores them in an N*2 array

number_of_machines = Count_WT()

'I use an temporary array since I cannot manage to define well the array_read_coordinates.
ReDim WTG_coord(1 To number_of_machines, 1 To 2) As Double

For i = 1 To number_of_machines
    WTG_coord(i, 1) = Application.ThisWorkbook.Worksheets("Layout").Cells(5 + i, "H").Value
    WTG_coord(i, 2) = Application.ThisWorkbook.Worksheets("Layout").Cells(5 + i, "I").Value
Next

read_coordinates = WTG_coord
Set WTG_coor = Nothing
End Function

现在,我有另一个功能,我想用它来改变旋转后坐标的值:

Function Rotate_coordinate(coord_system() As Variant, theta As Long)
''' This function determine the coordinates of the machines after a rotation of an angle of 270 - theta
'coord_system is the array of the initial coordinates of the machines
'theta is the angle of view

'We define the rotation matrix for the angle 270-theta
Dim M(1 To 2, 1 To 2) As Double
M(1, 1) = -Sin(theta)
M(1, 2) = Cos(theta)
M(2, 1) = -Cos(theta)
M(2, 2) = -Sin(theta)

x = UBound(coord_system, 1)          'We read the length of the matrix (ie  get the number of WTG)
Dim Rotate_coordinate(1 To x, 1 To 2)
For i = 1 To x
    Rotate_coordinate(i, 1) = M(1, 1) * coord_system(i, 1) + M(1, 2) *  coord_system(i, 2)
    Rotate_coordinate(i, 2) = M(2, 1) * coord_system(i, 1) + M(2, 2) * coord_system(i, 2)
Next

End Function

我想将此函数用作通用函数,因为稍后我将不得不将它与多个coord_systems一起使用。

提前感谢您的建议!

2 个答案:

答案 0 :(得分:0)

您应该使用ByRef在函数,子或属性中传递数组。

声明:

Function MyFunction (ByRef MyArray() As long)
'Code goes here
End Function

答案 1 :(得分:0)

我正在使用标准的右手旋转,以便根据输入返回一个新的旋转数组:

Public Function RotateCoordinatesDegree(ByRef Coords() As Double, ByVal angle_deg As Double) As Double()
    Dim rot() As Double, cx As Double, sx As Double, x As Double
    Dim i As Long, N As Long
    N = UBound(Coords, 1)
    ReDim rot(1 To N, 1 to 2)
    x = WorksheetFunction.Radians(angle_deg)
    sx = Sin(x): cx = Cos(x)
    For i = 1 To N
        rot(i, 1) = Coords(i, 1) * cx - Coords(i, 2) * sx
        rot(i, 2) = Coords(i, 1) * sx + Coords(i, 2) * cx
    Next i
    RotateCoordinates = rot
End Function

Public Sub TestCoord()
    Dim cs1() As Double, cs2() As Double, theta, i As Long
    ReDim cs1(1 To 10, 1 To 2)
    For i = 1 To 10
        cs1(i, 1) = CDbl(i) / 10#: cs1(i, 2) = 1#
    Next i
    theta = 15
    cs2 = RotateCoordinatesDegree(cs1, 270 - theta)

End Sub

修改1

如果您只想修改现有坐标,请尝试使用

Public Sub RotateCoordinatesDegree(ByRef Coords() As Double, ByVal angle_deg As Double) 
    Dim cx As Double, sx As Double, ang As Double, x as Double, y as Double
    Dim i As Long, N As Long
    N = UBound(Coords, 1)
    ang = WorksheetFunction.Radians(angle_deg)
    sx = Sin(ang): cx = Cos(ang)
    For i = 1 To N
        x = Coords(i, 1) * cx - Coords(i, 2) * sx
        y = Coords(i, 1) * sx + Coords(i, 2) * cx
        Coords(i,1) = x : Coords(i,2) = y
    Next i
End Sub

Public Sub TestCoord()
    Dim cs1() As Double, theta, i As Long
    ReDim cs1(1 To 10, 1 To 2)
    For i = 1 To 10
        cs1(i, 1) = CDbl(i) / 10#: cs1(i, 2) = 1#
    Next i
    theta = 15
    RotateCoordinatesDegree cs1, 270 - theta

End Sub