复制 Google 表格 {array1; array2} 函数在 Microsoft Excel 中作为用户定义函数

Question

在 Google 表格中，我可以使用 ={range1;range2;...} 表示法将多个范围附加到一个范围中，作为公式的一部分。在 Excel 中，此功能似乎不能作为公式使用。我想创建一个用户定义的函数来允许我在 Excel 中附加范围。

理想情况下，该功能应具有与 Google 表格版本类似的简单性。 我附上了带有基本用例的link to a public Google Sheets 文档，以防万一。

我试过Tom's answer，但它给出了一个错误（见example photo）。

谢谢！

Answer 1

这是一个通用的 UDF，用于堆叠相同列数的范围：

Function vStack(ParamArray rng() As Variant) As Variant
    If TypeName(rng(1)) <> "Range" Then Exit Function
    Dim otarr() As Variant
    ReDim otarr(1 To 100000, 1 To rng(1).Columns.Count)
    
    Dim z As Long
    z = 1
    
    Dim i As Long
    For i = LBound(rng) To UBound(rng)
        If TypeName(rng(i)) <> "Range" Then Exit Function
        If i > LBound(rng) Then
            If rng(i).Columns.Count <> rng(i - 1).Columns.Count Then Exit Function
        End If
        Dim rngarr As Variant
        rngarr = Intersect(rng(i), rng(i).Parent.UsedRange)
        Dim j As Long
        For j = LBound(rngarr, 1) To UBound(rngarr, 1)
            Dim k As Long
            For k = LBound(rngarr, 2) To UBound(rngarr, 2)
                otarr(z, k) = rngarr(j, k)
            Next k
            z = z + 1
        Next j
    Next i
    
    Dim nArray() As Variant
    ReDim nArray(1 To z - 1, 1 To UBound(otarr, 2))
    
    For i = 1 To z - 1
        For j = 1 To UBound(otarr, 2)
            nArray(i, j) = otarr(i, j)
        Next j
    Next i
    
    vStack = nArray

End Function

请注意，我将初始数组限制为 100,000 行。如果这还不够，您可以将其提升到您想要的任何程度，但也要考虑“我是否将 Excel 视为数据库？”。如果答案是肯定的，那么是时候切换到实际的参考数据库了。

然后可以在公式中使用它：

=FILTER(vStack(A:C,F:H),vStack(A:A,F:F)="Apples")

---

编辑以包含适用于数组的版本，即：=vstack({1;2;3},{4;5;6})

Function vStack(ParamArray rng() As Variant) As Variant
    Dim otarr() As Variant
    If TypeName(rng(1)) = "Range" Then
        ReDim otarr(1 To 100000, 1 To rng(1).Columns.Count)
    Else
        ReDim otarr(1 To 100000, 1 To UBound(rng(1), 2))
    End If
        
    
    
    Dim z As Long
    z = 1
    
    Dim i As Long
    For i = LBound(rng) To UBound(rng)
        
        If i > LBound(rng) Then
            If TypeName(rng(i)) = "Range" Then
                If rng(i).Columns.Count <> UBound(otarr, 2) Then Exit Function
            Else
                If UBound(rng(i), 2) <> UBound(otarr, 2) Then Exit Function
            End If
        End If
        Dim rngarr As Variant
        If TypeName(rng(i)) = "Range" Then
            rngarr = Intersect(rng(i), rng(i).Parent.UsedRange)
        Else
            rngarr = rng(i)
        End If

        Dim j As Long
        For j = LBound(rngarr, 1) To UBound(rngarr, 1)
            Dim k As Long
            For k = LBound(rngarr, 2) To UBound(rngarr, 2)
                otarr(z, k) = rngarr(j, k)
            Next k
            z = z + 1
        Next j
    Next i
    
    Dim nArray() As Variant
    ReDim nArray(1 To z - 1, 1 To UBound(otarr, 2))
    
    For i = 1 To z - 1
        For j = 1 To UBound(otarr, 2)
            nArray(i, j) = otarr(i, j)
        Next j
    Next i
    
    vStack = nArray

End Function

Answer 2

已更新动态可用范围

这个函数应该创建你想要的。请注意，这不考虑空格或标题。 See sample spreadsheet with working result.

Function combineRange(ParamArray theRanges() As Variant) As Variant()
    Dim totalColumns As Long, z As Long, r As Long, g As Long, aCell As Range
    
    ReDim zRanges(0) As Range
    For r = LBound(theRanges) To UBound(theRanges)
        ReDim Preserve zRanges(r)
        Set zRanges(r) = theRanges(r)
        Set zRanges(r) = Intersect(zRanges(r), zRanges(r).Worksheet.UsedRange)
       
        totalColumns = Application.WorksheetFunction.Max(zRanges(r).Columns.Count, totalColumns)
    Next r
    
    r = 1
    
    ReDim theRay(1 To totalColumns, 1 To r)
    
    For z = LBound(zRanges) To UBound(zRanges)
        For Each aCell In zRanges(z).Columns(1).Cells
           ReDim Preserve theRay(1 To totalColumns, 1 To r)
            For g = 1 To zRanges(z).Columns.Count
                theRay(g, r) = aCell.Offset(0, g - 1).Value
            Next g
            r = r + 1
        Next aCell
    Next z
    
    combineRange = Application.WorksheetFunction.Transpose(theRay)
End Function