VBA返回动态数组并分配给变量

Question

Return dynamic array from function VBA帮助我解决了这个问题。我意识到在调用该功能之前我应该​​知道大小。

Function GetHeadersFromRange(DataRange As Range, Size As Integer) As Variant
    Dim Column As Integer
    Dim Headers As Variant
    ReDim Headers(0 To Size)

    For Column = 1 To DataRange.Columns.Count
        Headers(Column) = DataRange(1, Column).Value
    Next
    GetHeadersFromRange = Headers
End Function 

Sub TestGetHeadersFromRange()
    Application.DisplayAlerts = False
    Set wb = ThisWorkbook
    Set TestSheet = wb.Sheets.Add()

    TestSheet.Range("A1").Value = "my_header"
    TestSheet.Range("A2").Value = "val"

    Dim DataRange As Range: Set DataRange = TestSheet.Range("A1:A2")
    Dim Size As Integer: Size = DataRange.Columns.Count
    Dim Result As Variant

    ' Gets type mismatch
    Set Result = GetHeadersFromRange(DataRange, Size)
End Sub 

不确定在这里做什么。我需要在多个地方使用此功能，这就是为什么首先要使用该功能的原因。

编辑：澄清问题 Set Result = GetHeadersFromRange(...)的类型不匹配。

Answer 1

标题功能

改进

• 发生错误是因为您正在使用Set（用于对象） 在数组上。
• 比遍历范围更有效（更快）的方法是循环 通过数组。
• 将范围复制到变量（可能是数组）时，如果范围 包含一个单元格，则变体将仅包含一个值。但是如果 该范围包含多个单元格，它将是一个数组，其大小为 UBound返回。因此，不需要Size参数。
• IsArray用于确定变量是否为数组。在本例中，我们可以检查列（元素）的数量是否大于1。

Option Explicit

Function GetHeadersFromRange(DataRange As Range) As Variant

    Dim vntR As Variant   ' Range Variant
    Dim vntH As Variant   ' Header Array
    Dim Noe As Long       ' Number of Elements
    Dim j As Long         ' Range Array Column Counter,
                          ' Header Array Element Counter

    With DataRange
        ' Calculate Number of Elements.
        Noe = .Columns.Count
        ' Calculate Header Range.
        ' Copy Header Range to Range Variant.
        vntR = .Resize(1, Noe)
        ' Note: Range Variant (vntR) is a 2D 1-based 1-row array only if
        '       DataRange contains more than one column. Otherwise it is
        '       a variant containing one value.
    End With

    '' Check if Range Variant is an array.
    'If IsArray(vntR) Then
    ' Check if Number of Elements is greater than 1.
    If Noe > 1 Then
        ' Resize 1D 0-based Header Array to number of columns (2) in Range
        ' Array minus 1 (0-based).
        ReDim vntH(Noe - 1)
        ' Loop through columns of Range Array.
        For j = 1 To Noe
            ' Write value at first row (1) and current column (j) of Range
            ' Array to current element (j-1) of Header Array.
            vntH(j - 1) = vntR(1, j)
        Next
      Else
        ' Resize 1D 0-based Header Array to one element only (0).
        ReDim vntH(0)
        ' Write Range Variant value to only element of Header Array.
        vntH(0) = vntR
    End If

    GetHeadersFromRange = vntH

End Function


Sub TestGetHeadersFromRange()

    Dim TestSheet As Worksheet  ' Source Worksheet
    Dim DataRange As Range      ' Data Range
    Dim Result As Variant       ' Result Variant (possibly Array)
    Dim i As Long               ' Result Array Element Counter

    ' Add a new worksheet (Source Worksheet).
    ' Create a reference to the newly added Source Worksheet.
    Set TestSheet = ThisWorkbook.Sheets.Add()

    ' In Source Worksheet
    With TestSheet
        ' Add some values.
        .Range("A1").Value = "my_header"
        .Range("A2").Value = "val"
        .Range("B1").Value = "my_header2"
        .Range("B2").Value = "val2"
    End With

' Test 1:
    Debug.Print "Test1:"
    ' Create a reference to DataRange.
    Set DataRange = TestSheet.Range("A1:A2")
    ' Write Data Range to 1D 0-based Result Array.
    Result = GetHeadersFromRange(DataRange)
    ' Loop through elements of Result Array.
    For i = 0 To UBound(Result)
        ' Write current element of Result Array to Immediate window.
        Debug.Print Result(i)
    Next

' Test 2:
    Debug.Print "Test2:"
    ' Create a reference to DataRange.
    Set DataRange = TestSheet.Range("A1:B2")
    ' Write Data Range to 1D 0-based Result Variant.
    Result = GetHeadersFromRange(DataRange)
    ' Loop through elements of Result Array.
    For i = 0 To UBound(Result)
        ' Write current element of Result Array to Immediate window.
        Debug.Print Result(i)
    Next


End Sub