VBA数组调用IntersectComplex时出现ByRef参数类型不匹配错误

运行代码计算旋转矩形与多条水平线的交点时，在以下行触发ByRef参数类型不匹配错误：

aa(i) = IntersectComplex(XLine1(i), YLine1(i), XLine2(i), YLine2(i), Side1, True)

确认错误后，XLine1(i)被高亮标记。完整代码如下：

Dim Xc(1 To 4) As Double
Dim Yc(1 To 4) As Double
Dim Theta_D, Theta_R As Double
Dim Xc_R(1 To 4) As Double
Dim Yc_R(1 To 4) As Double
Dim Side1, Side2, Side3, Side4 As Range
Dim nfibers As Integer
Dim x1(1 To 4), x2(1 To 4), y1(1 To 4), y2(1 To 4) As Double


Dim tf() As Double
Dim Yf(), df() As Double
Dim XLine1(), XLine2(), YLine1(), YLine2() As Double
Dim aa(), bb(), cc(), dd() As Double
Dim Xint1(), Xint2(), Xint3(), Xint4() As Variant
Dim Yint1(), Yint2(), Yint3(), Yint4() As Double
Dim Px1(), Px2() As Double
Dim XCG(), YCG() As Double

nfibers = 30

ReDim tf(1 To nfibers) As Double
ReDim Yf(1 To nfibers + 1), df(1 To nfibers + 1) As Double
ReDim XLine1(1 To nfibers + 1), XLine2(1 To nfibers + 1), YLine1(1 To nfibers + 1), YLine2(1 To nfibers + 1) As Double
ReDim aa(1 To nfibers + 1), bb(1 To nfibers + 1), cc(1 To nfibers + 1), dd(1 To nfibers + 1) As Double
ReDim Xint1(1 To nfibers + 1), Xint2(1 To nfibers + 1), Xint3(1 To nfibers + 1), Xint4(1 To nfibers + 1) As Variant
ReDim Yint1(1 To nfibers + 1), Yint2(1 To nfibers + 1), Yint3(1 To nfibers + 1), Yint4(1 To nfibers + 1) As Double
ReDim Px1(1 To nfibers + 1), Px2(1 To nfibers + 1) As Double
ReDim XCG(1 To nfibers), YCG(1 To nfibers) As Double



b = ThisWorkbook.Worksheets("Sheet1").Range("C2").Value
t = ThisWorkbook.Worksheets("Sheet1").Range("C3").Value
Theta_D = ThisWorkbook.Worksheets("Sheet1").Range("C4").Value
Theta_R = Application.WorksheetFunction.Radians(Theta_D)

Cos_T = Math.Cos(Theta_R)
Sin_T = Math.Sin(Theta_R)
Tan_T = Math.Tan(Theta_R)

Xc(1) = b / 2
Xc(2) = -b / 2
Xc(3) = -b / 2
Xc(4) = b / 2
Xc(5) = b / 2

Yc(1) = t / 2
Yc(2) = t / 2
Yc(3) = -t / 2
Yc(4) = -t / 2
Yc(5) = t / 2

ThisWorkbook.Worksheets("Sheet1").Range("G3").Value = Xc(1)
ThisWorkbook.Worksheets("Sheet1").Range("G4").Value = Xc(2)
ThisWorkbook.Worksheets("Sheet1").Range("I3").Value = Xc(2)
ThisWorkbook.Worksheets("Sheet1").Range("I4").Value = Xc(3)
ThisWorkbook.Worksheets("Sheet1").Range("K3").Value = Xc(3)
ThisWorkbook.Worksheets("Sheet1").Range("K4").Value = Xc(4)
ThisWorkbook.Worksheets("Sheet1").Range("M3").Value = Xc(4)
ThisWorkbook.Worksheets("Sheet1").Range("M4").Value = Xc(1)

ThisWorkbook.Worksheets("Sheet1").Range("H3").Value = Yc(1)
ThisWorkbook.Worksheets("Sheet1").Range("H4").Value = Yc(2)
ThisWorkbook.Worksheets("Sheet1").Range("J3").Value = Yc(2)
ThisWorkbook.Worksheets("Sheet1").Range("J4").Value = Yc(3)
ThisWorkbook.Worksheets("Sheet1").Range("L3").Value = Yc(3)
ThisWorkbook.Worksheets("Sheet1").Range("L4").Value = Yc(4)
ThisWorkbook.Worksheets("Sheet1").Range("N3").Value = Yc(4)
ThisWorkbook.Worksheets("Sheet1").Range("N4").Value = Yc(1)

Set Side1 = Range("G3:H4")
Set Side2 = Range("I3:J4")
Set Side3 = Range("K3:L4")
Set Side4 = Range("M3:N4")


For i = 1 To 4 Step 1
    Xc_R(i) = (Xc(i) * Cos_T) + (Yc(i) * Sin_T)
    Yc_R(i) = (-Xc(i) * Sin_T) + (Yc(i) * Cos_T)
Next i

Y1max = Application.WorksheetFunction.Large(Yc_R, 1)
Y2max = Application.WorksheetFunction.Large(Yc_R, 2)
Y3max = Application.WorksheetFunction.Large(Yc_R, 3)
Y4max = Application.WorksheetFunction.Large(Yc_R, 4)

hzone1 = Y1max - Y2max
hzone2 = Y2max - Y3max
hzone3 = Y3max - Y4max
d1max = Y1max - Y1max
d2max = Y1max - Y2max
d3max = Y1max - Y3max
d4max = Y1max - Y4max

'each zone has equal fibers but not equal fiber thicknesses
If Theta_D = 0 Or Theta_D = 90 Or Theta_D = 180 Or Theta_D = 270 Or Theta_D = 360 Then
    nfibers_Zone1 = 0
    tf_zone1 = 0
    nfibers_Zone2 = nfibers
    tf_zone2 = hzone2 / nfibers_Zone2
    nfibers_Zone3 = 0
    tf_zone3 = 0
Else
    nfibers_Zone1 = nfibers / 3
    tf_zone1 = hzone1 / nfibers_Zone1
    nfibers_Zone2 = nfibers / 3
    tf_zone2 = hzone2 / nfibers_Zone2
    nfibers_Zone3 = nfibers / 3
    tf_zone3 = hzone3 / nfibers_Zone3
End If

'Line Starts and ends
For i = 1 To 4
    x1(i) = Xc_R(i)
    x2(i) = Xc_R(i + 1)
    y1(i) = Yc_R(i)
    y2(i) = Yc_R(i + 1)
Next i

'Horizontal Lines for fibers
'Different zones
'Zone1
For i = 0 To nfibers
    If i >= 0 And i < nfibers / 3 Then
        tff = tf_zone1
    ElseIf i >= (nfibers / 3) And i < (2 / 3) * nfibers Then
        tff = tf_zone2
    Else
        tff = tf_zone3
    End If
    
    Yf(i) = Y1max - (tff * i)
    df(i) = Y1max - Yf(i)
    
    YLine1(i) = Yf(i)
    YLine2(i) = Yf(i)
    
    XLine1(i) = -100000
    XLine2(i) = 100000
    
    
    On Error Resume Next
    aa(i) = IntersectComplex(XLine1(i), YLine1(i), XLine2(i), YLine2(i), Side1, True)
    bb(i) = IntersectComplex(XLine1(i), YLine1(i), XLine2(i), YLine2(i), Side2, True)
    cc(i) = IntersectComplex(XLine1(i), YLine1(i), XLine2(i), YLine2(i), Side3, True)
    dd(i) = IntersectComplex(XLine1(i), YLine1(i), XLine2(i), YLine2(i), Side4, True)
    
    Xint1(i) = Application.WorksheetFunction.IfError(aa(i), "")
    Xint2(i) = Application.WorksheetFunction.IfError(bb(i), "")
    Xint3(i) = Application.WorksheetFunction.IfError(cc(i), "")
    Xint4(i) = Application.WorksheetFunction.IfError(dd(i), "")
    
    Yint1(i) = Yf(i)
    Yint2(i) = Yf(i)
    Yint3(i) = Yf(i)
    Yint4(i) = Yf(i)
    
    If Xint1(i) <> "" Then
        Px1(i) = Xint1(i)
    ElseIf Xint2(i) <> "" Then
        Px1(i) = Xint2(i)
    ElseIf Xint3(i) <> "" Then
        Px1(i) = Xint3(i)
    End If
    
    If Xint2(i) <> "" Then
        Px2(i) = Xint2(i)
    ElseIf Xint3(i) <> "" Then
        Px2(i) = Xint3(i)
    ElseIf Xint4(i) <> "" Then
        Px2(i) = Xint4(i)
    End If
    
Next i

For i = 1 To nfibers
    XCG(i) = Application.WorksheetFunction.Average(Px1(i), Px2(i))
    YCG(i) = Application.WorksheetFunction.Average(Yf(i), Yf(i))
Debug.Print XCG(i)
Debug.Print YCG(i)

Next i

1. 修正数组声明的语法错误 #

VBA中一行声明多个变量时，仅最后一个变量会被指定类型，前面的变量默认是Variant类型。比如：

Dim XLine1(), XLine2(), YLine1(), YLine2() As Double

这里只有YLine2()是Double类型，其余三个数组都是Variant类型，传递给要求Double参数的函数时就会触发类型不匹配。

修正方式：每个数组单独声明类型：

Dim XLine1() As Double
Dim XLine2() As Double
Dim YLine1() As Double
Dim YLine2() As Double

同理，其他多行声明的变量也需要拆分单独声明，避免隐式Variant类型。

2. 检查IntersectComplex函数的参数定义 #

如果IntersectComplex是自定义函数，确认它的前四个参数是否要求接收Range对象而非数值。如果是，你需要将水平线的坐标存入单元格Range后再传递，而非直接传入数值。

如果它是计算线段交点的函数，要求传入坐标数值，那修正数组类型后即可解决问题。

3. 替代方案：自行实现线段交点计算 #

若IntersectComplex的定义不明确，可自行编写交点计算函数，避免依赖第三方函数：

Function GetLineIntersection(x1 As Double, y1 As Double, x2 As Double, y2 As Double, _
                            x3 As Double, y3 As Double, x4 As Double, y4 As Double) As Variant
    Dim denom As Double, num1 As Double, num2 As Double
    denom = (y4 - y3) * (x2 - x1) - (x4 - x3) * (y2 - y1)
    If denom = 0 Then
        GetLineIntersection = Empty ' 平行或重合，无交点
        Exit Function
    End If
    num1 = (x4 - x3) * (y1 - y3) - (y4 - y3) * (x1 - x3)
    num2 = (x2 - x1) * (y1 - y3) - (y2 - y1) * (x1 - x3)
    Dim u1 As Double, u2 As Double
    u1 = num1 / denom
    u2 = num2 / denom
    If u1 >= 0 And u1 <= 1 And u2 >= 0 And u2 <= 1 Then
        GetLineIntersection = Array(x1 + u1 * (x2 - x1), y1 + u1 * (y2 - y1))
    Else
        GetLineIntersection = Empty ' 交点在线段外
    End If
End Function

调用时提取Side1的端点坐标：

Dim x3 As Double, y3 As Double, x4 As Double, y4 As Double
x3 = Side1.Cells(1, 1).Value
y3 = Side1.Cells(1, 2).Value
x4 = Side1.Cells(2, 1).Value
y4 = Side1.Cells(2, 2).Value
Dim intersectPoint As Variant
intersectPoint = GetLineIntersection(XLine1(i), YLine1(i), XLine2(i), YLine2(i), x3, y3, x4, y4)
If Not IsEmpty(intersectPoint) Then
    aa(i) = intersectPoint(0)
Else
    aa(i) = Empty
End If

内容的提问来源于stack exchange，提问作者Abdullah El-Ezmazy