VBA UDF 返回数组

Posted 2023-04-13

【中文标题】VBA UDF 返回数组

【英文标题】：VBA UDF Return Array

【发布时间】：2016-07-19 06:30:43

【问题描述】：

我有以下 UDF，它需要遍历工作表上名为 Classes 的所有数据，如果学生姓名显示在工作表上的列表中，则返回学生姓名和班级名称（A 列和 B 列）称为时间表（此列表位于单元格 BM3 到 BM21 中），课程在 UDF 中输入的日期和时间进行。目前它返回 #Value 错误。我做错了什么？

Function TTDisplay(Day As String, Time As Variant) As Variant

Dim Result(1 To 12) As String
Dim Students As String
Dim cell As Integer
Dim LastRow As Long
Dim Classes As Worksheet
Dim Timetable As Worksheet
Dim x As Integer
Dim TimeSpan As Integer
Dim TTTime As Integer

Classes = Sheets("Classes")
Timetable = Sheets("Timetable")
LastRow = Classes.Cells(Classes.Rows.count, "A").End(xlUp).Row
TTTime = TMins(Time)

For cell = 3 To 21
Students = Students & Timetable.Cells(cell, 65).value & "!"
Next cell

x = 1
For cell = 2 To LastRow

        If InStr(Students, Classes.Cells(cell, 2)) Then
            If Day = Classes.Cells(cell, 9) Then
                If Time = Classes.Cells(cell, 12) Then
                Result(x) = Classes.Cells(cell, 2) & Chr(10) & Classes.Cells(cell, 1)
                x = x + 1
                Else
                TimeSpan = TMins(Classes.Cells(cell, 12)) + 30
                    Do While TimeSpan < TMins(Classes.Cells(cell, 11))
                        If TimeSpan = TTTime Then
                        Result(x) = Classes.Cells(cell, 2) & Chr(10) & Classes.Cells(cell, 1)
                        x = x + 1
                        GoTo MoveOn
                        Else
                        TimeSpan = TimeSpan + 30
                        End If
                    Loop
MoveOn:
                End If
            End If
        End If

Next cell
TTDisplay = Result(1)
End Function

【问题讨论】：

Result 是 1 到 12，您确定不超过 12 个条目吗？在For cell = 2 To LastRow 之后直接输入If x = 13 Then Exit For 并再次检查...或者更好，逐行运行代码...

【参考方案1】：

如果你想返回一个数组，你可以将函数定义为Variant，但最好把你的函数头改成这个（这样更容易直接看到函数的返回类型）：

Function TTDisplay(Day As String, Time As Variant) As String()

在最后一行 (TTDisplay = Result(1)) 您只返回一个值，因此将其更改为返回整个数组：TTDisplay = Result

【参考方案2】：

TTDisplay = Result(1) 将 UDF 的值设置为数组中的第一个元素。 TTDisplay = Result 将返回完整的数组。 您还必须使用 ctrl+shift+enter =TTDisplay($A2,$B2) 将公式作为数组公式输入。

我修改了您的代码，使数组动态化。

Function TTDisplay(Day As String, Time As Variant) As Variant

    Dim Result() As String
    Dim Students As String
    Dim cell As Integer
    Dim LastRow As Long
    Dim Classes As Worksheet
    Dim Timetable As Worksheet
    Dim x As Integer
    Dim TimeSpan As Integer
    Dim TTTime As Integer

    Classes = Sheets("Classes")
    Timetable = Sheets("Timetable")
    LastRow = Classes.Cells(Classes.Rows.Count, "A").End(xlUp).Row
    TTTime = TMins(Time)

    For cell = 3 To 21
        Students = Students & Timetable.Cells(cell, 65).Value & "!"
    Next cell

    x = 0
    ReDim Result(x)

    For cell = 2 To LastRow

        If InStr(Students, Classes.Cells(cell, 2)) Then
            If Day = Classes.Cells(cell, 9) Then
                If Time = Classes.Cells(cell, 12) Then
                    ReDim Preserve Result(x)
                    Result(x) = Classes.Cells(cell, 2) & Chr(10) & Classes.Cells(cell, 1)
                    x = x + 1
                Else
                    TimeSpan = TMins(Classes.Cells(cell, 12)) + 30
                    Do While TimeSpan < TMins(Classes.Cells(cell, 11))
                        If TimeSpan = TTTime Then
                            ReDim Preserve Result(x)
                            Result(x) = Classes.Cells(cell, 2) & Chr(10) & Classes.Cells(cell, 1)
                            x = x + 1
                            GoTo MoveOn
                        Else
                            TimeSpan = TimeSpan + 30
                        End If
                    Loop
MoveOn:
                End If
            End If
        End If

    Next cell
    TTDisplay = Result
End Function