无法将超过行的范围转换为 Excel VBA 中的可用数组

Question

我在 Excel VBA 中有以下代码将多行和多列的范围转换为数组，以便我可以将其转换为字符串并将信息存储为字符串：

Sub pruebaString()
    Dim str As String
    Dim ar As Variant
    
    ar = Hoja2.Names("AREA1").RefersToRange
    Debug.Print TypeName(ar(1)) 'GIVES ERROR
    str = Join(ar(1)) 'GIVES ERROR
    Debug.print ar(1,2) 'outputs the results correctly.
    debug.print LBound(ar) & ", " & UBound(ar) 'outputs the expected bounds.
End Sub

给我一​​个“越界”错误。 Range 是一个 4x4 的区域，所以数组应该是一个二维数组。 尝试对 ar(1) 进行连接也会出现“超出范围错误”。

将它转换为数组的代码看起来很简单，我是从互联网上获取的。显然这是完成这项工作所需要做的唯一事情，只需将范围分配给 Variant 非数组变量即可。

这让我发疯了，因为它似乎具有二维数组的结构并且可以像 ar(1,1)、ar(1,2) 等一样访问它，但是当尝试加入每个内部数组没有。 我基本上想加入内部数组，然后用不同的分隔符将所有内容连接在一起，这样我就有了一串行和列，比如 1,2,1;4,2,1 等等。 我正在使用 Excel 2002

有什么想法吗？

Answer 1

加入数组行或列

• 将行或列作为一维数组获取的一种简单方法是使用Application.Index 和Application.Transpose，但有其局限性（速度慢，元素数量有限）。
• 将范围的行或列与Application.Transpose 一起使用可能更有效。
• 最有效的方法是编写一个循环遍历二维数组的行或列并返回一维数组的函数。
• 要对此进行测试，请将代码复制到新工作簿的标准模块中，并在单元格 A1 的 Sheet1 中放置一个值表。在 VBE 立即窗口 (Ctrl+G) 中监视输出。

Option Explicit

Sub JoinArrayRowOrColumn()
    
    Dim rg As Range: Set rg = Sheet1.Range("A1").CurrentRegion
    Dim Data As Variant: Data = rg.Value ' 2D one-based array
    
    ' Join first row (note the 'double transpose').
    Dim rArr As Variant: rArr = Application.Transpose( _
        Application.Transpose(Application.Index(Data, 1, 0)))
    Debug.Print Join(rArr, ", ")
    
    ' Join first column.
    Dim cArr As Variant
    cArr = Application.Transpose(Application.Index(Data, 0, 1))
    Debug.Print Join(cArr, ", ")

    ' Without using the 'indermediate' ('Data') array (probably more efficient):
    
    rArr = Application.Transpose(Application.Transpose(rg.Rows(1).Value))
    Debug.Print Join(rArr, ", ")
    
    cArr = Application.Transpose(rg.Columns(1).Value)
    Debug.Print Join(cArr, ", ")

End Sub

一行的函数

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Returns the values of a row of a 2D array in a 1D array.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function ArrRow( _
    ByVal Data As Variant, _
    ByVal RowIndex As Long, _
    Optional ByVal FirstIndex As Long = 0) _
As Variant
    Const ProcName As String = "ArrRow"
    On Error GoTo ClearError
    
    If IsEmpty(Data) Then Exit Function
    If RowIndex < LBound(Data, 1) Then Exit Function
    If RowIndex > UBound(Data, 1) Then Exit Function
    
    Dim LB2 As Long: LB2 = LBound(Data, 2)
    Dim UB2 As Long: UB2 = UBound(Data, 2)
    
    Dim cDiff As Long: cDiff = LB2 - FirstIndex

    Dim rArr As Variant: ReDim rArr(FirstIndex To FirstIndex + UB2 - LB2)

    Dim c As Long
    
    For c = LB2 To UB2
        rArr(c - cDiff) = Data(RowIndex, c)
    Next c
    
    ArrRow = rArr
'    Debug.Print ProcName & ": [LB=" & LBound(ArrRow) _
'        & ",UB=" & UBound(ArrRow) & "]"
'    Debug.Print ProcName & ": [" & Join(ArrRow, ", ") & "]"
   
ProcExit:
    Exit Function
ClearError:
    Debug.Print "'" & ProcName & "': Unexpected Error!" & vbLf _
              & "    " & "Run-time error '" & Err.Number & "':" & vbLf _
              & "    " & Err.Description
    Resume ProcExit
End Function

Sub ArrRowTEST()
    Dim rg As Range: Set rg = Sheet1.Range("A1").CurrentRegion
    ' Note that if rg contains more than one (contiguous) cell,
    ' rg.Value is actually a 2D one-based array already.
    Dim rArr As Variant: rArr = ArrRow(rg.Value, 1)
    If Not IsEmpty(rArr) Then
        Debug.Print Join(rArr, ", ")
    End If
End Sub