使用 sub 在函数中调用数组答案

【问题标题】：Using a sub to call an array within a function使用 sub 在函数中调用数组
【发布时间】：2020-09-24 09:16:43
【问题描述】：

我的潜艇有点问题。这个 sub 通过使用 sub 的数据调用不同的函数。第一个函数查找一个是查找唯一值的数量，第二个函数查找这些值。但是，第一个函数可以正常工作，因为它的输出是一个标量值。但是，第二个函数的输出是一个数组。我试图寻找解决方案，但到目前为止我还没有成功。我有一个理论认为这个问题与ByRef A() As Integer 有关。我已经为 sub 和第二个函数编写了下面的代码。

Sub Test()
Dim A() As Integer
Dim n As Integer
Dim BB As Integer
n = 10
ReDim A(n, 2) '5 unikke

A(1, 1) = 1
A(2, 1) = 7
A(3, 1) = 2
A(4, 1) = 6
A(5, 1) = 3
A(6, 1) = 5
A(7, 1) = 1
A(8, 1) = 1
A(9, 1) = 1
A(10, 1) = 4

A(1, 2) = 1
A(2, 2) = 7
A(3, 2) = 2
A(4, 2) = 6
A(5, 2) = 3
A(6, 2) = 5
A(7, 2) = 1
A(8, 2) = 1
A(9, 2) = 1
A(10, 2) = 4

BB = Unikke(A) 'Unikke is the second function that provides the amount of unique values
Dim FF() As Integer
ReDim FF(BB, 1)

FF = HvilkeUnikke(A) 'the second function, which has the output of an array a.k.a the problem

End Sub

这是函数：

Public Function HvilkeUnikke(ByRef A() As Integer) As Integer

Dim L() As Integer
Dim B As Integer
Dim i As Integer
Dim i2 As Integer
Dim A2() As String
Dim BB As Integer
Dim C() As Integer

BB = Unikke(A)

ReDim C(UBound(A), 2)
ReDim A2(BB, 1)
ReDim L(BB, 1)

For i = 1 To UBound(A)
    C(i, 1) = A(i, 1)
    C(i, 2) = A(i, 2)
Next

For i = 1 To UBound(C)
B = 0
    For i2 = 1 To UBound(C)
        If C(i, 1) = C(i2, 2) Then
            B = B + 1
            If B > 1 Then
                C(i2, 2) = 0
            End If
        End If
    Next i2
Next i

B = 0
For i2 = 1 To UBound(C)
    If C(i2, 2) > 0 Then
        B = B + 1
        L(B, 1) = C(i2, 2)

    End If
Next i2


HvilkeUnikke = L
End Function

结果符合预期，但它们应该在我的子目录中的一个变量中。

【问题讨论】：

您已将 FF 标注为整数数组 Dim FF() As Integer 但您尝试填充它的函数仅返回一个整数 Public Function HvilkeUnikke(ByRef A() As Integer) As Integer - 即使您尝试将其值设置为再次使用 HvilkeUnikke = L 的整数数组，其中 L 是 int 数组 L()
Bascally，您可以尝试将() 放在函数声明/签名的末尾吗？将Public Function HvilkeUnikke(ByRef A() As Integer) As Integer 更改为Public Function HvilkeUnikke(ByRef A() As Integer) As Integer()
没错，变量L也有问题，现在已经解决了。但是，第二条评论非常有帮助。现在它可以工作了，我将为需要帮助的其他人更新上面的代码。谢谢！
干得好，祝你好运！
你不应该在你的问题中回答你的问题。你应该写一个答案，如果@jamheadart 不想写你自己的答案是完全没问题的

标签： arrays vba function

【解决方案1】：

（解决方案）

Sub test()

Dim FF() As Integer
Dim i As Integer
Dim A() As Integer
Dim n As Integer
Dim BB As Integer
n = 10
ReDim A(n, 2) '7 unikke

A(1, 1) = 1
A(2, 1) = 7
A(3, 1) = 2
A(4, 1) = 6
A(5, 1) = 3
A(6, 1) = 5
A(7, 1) = 1
A(8, 1) = 1
A(9, 1) = 1
A(10, 1) = 4

A(1, 2) = 1
A(2, 2) = 7
A(3, 2) = 2
A(4, 2) = 6
A(5, 2) = 3
A(6, 2) = 5
A(7, 2) = 1
A(8, 2) = 1
A(9, 2) = 1
A(10, 2) = 4


BB = Unikke(A)

ReDim FF(BB)

FF = HvilkeUnikke(A)

'Testing on the worksheet
For i = 1 To BB
    Cells(i, 1) = FF(i)
Next


End Sub

还有功能

Public Function HvilkeUnikke(ByRef A() As Integer) As Integer()

Dim L() As Integer
Dim B As Integer
Dim i As Integer
Dim i2 As Integer
Dim A2() As String
Dim BB As Integer
Dim C() As Integer

BB = Unikke(A)

ReDim C(UBound(A), 2)
ReDim A2(BB, 1)
ReDim L(BB)

For i = 1 To UBound(A)
    C(i, 1) = A(i, 1)
    C(i, 2) = A(i, 2)
Next

For i = 1 To UBound(C)
B = 0
    For i2 = 1 To UBound(C)
        If C(i, 1) = C(i2, 2) Then
            B = B + 1
            If B > 1 Then
                C(i2, 2) = 0
            End If
        End If
    Next i2
Next i

B = 0
For i2 = 1 To UBound(C)
    If C(i2, 2) > 0 Then
        B = B + 1
        L(B) = C(i2, 2)
    End If
Next i2


HvilkeUnikke = L

End Function

【讨论】：