如何在 Excel VBA 中对数组进行切片？

How do I slice an array in Excel VBA?

提问by Lance Roberts

What function can I use in Excel VBA to slice an array?

我可以在 Excel VBA 中使用什么函数来切片数组？

回答by Lance Roberts

Application.WorksheetFunction.Index(array, row, column)

Application.WorksheetFunction.Index(array, row, column)

If you specify a zero value for row or column, then you'll get the entire column or row that is specified.

如果您为行或列指定零值，那么您将获得指定的整个列或行。

Example:

例子：

Application.WorksheetFunction.Index(array, 0, 3)

Application.WorksheetFunction.Index(array, 0, 3)

This will give you the entire 3rd column.

这将为您提供整个第 3 列。

If you specify both row and column as non-zero, then you'll get only the specific element. There is no easy way to get a smaller slice than a complete row or column.

如果您将行和列都指定为非零值，那么您将只获得特定元素。没有比完整的行或列更小的切片的简单方法。

Limitation: There is a limit to the array size that WorksheetFunction.Indexcan handle if you're using a newer version of Excel. If arrayhas more than 65,536 rows or 65,536 columns, then it throws a "Type mismatch" error. If this is an issue for you, then see this more complicated answerwhich is not subject to the same limitation.

限制：WorksheetFunction.Index如果您使用的是较新版本的 Excel ，则可以处理的数组大小存在限制。如果array有超过 65,536 行或 65,536 列，则会引发“类型不匹配”错误。如果这对您来说是个问题，那么请参阅不受相同限制的更复杂的答案。

Here's the function I wrote to do all my 1D and 2D slicing:

这是我编写的用于执行所有 1D 和 2D 切片的函数：

Public Function GetArraySlice2D(Sarray As Variant, Stype As String, Sindex As Integer, Sstart As Integer, Sfinish As Integer) As Variant

' this function returns a slice of an array, Stype is either row or column
' Sstart is beginning of slice, Sfinish is end of slice (Sfinish = 0 means entire
' row or column is taken), Sindex is the row or column to be sliced
' (NOTE: 1 is always the first row or first column)
' an Sindex value of 0 means that the array is one dimensional 3/20/09 ljr

Dim vtemp() As Variant
Dim i As Integer

On Err GoTo ErrHandler

Select Case Sindex
    Case 0
        If Sfinish - Sstart = UBound(Sarray) - LBound(Sarray) Then
            vtemp = Sarray
        Else
            ReDim vtemp(1 To Sfinish - Sstart + 1)
            For i = 1 To Sfinish - Sstart + 1
                vtemp(i) = Sarray(i + Sstart - 1)
            Next i
        End If
    Case Else
        Select Case Stype
            Case "row"
                If Sfinish = 0 Or (Sstart = LBound(Sarray, 2) And Sfinish = UBound(Sarray, 2)) Then
                    vtemp = Application.WorksheetFunction.Index(Sarray, Sindex, 0)
                Else
                    ReDim vtemp(1 To Sfinish - Sstart + 1)
                    For i = 1 To Sfinish - Sstart + 1
                        vtemp(i) = Sarray(Sindex, i + Sstart - 1)
                    Next i
                End If
            Case "column"
                If Sfinish = 0 Or (Sstart = LBound(Sarray, 1) And Sfinish = UBound(Sarray, 1)) Then
                    vtemp = Application.WorksheetFunction.Index(Sarray, 0, Sindex)
                Else
                    ReDim vtemp(1 To Sfinish - Sstart + 1)
                    For i = 1 To Sfinish - Sstart + 1
                        vtemp(i) = Sarray(i + Sstart - 1, Sindex)
                    Next i
                End If
        End Select
End Select
GetArraySlice2D = vtemp
Exit Function

ErrHandler:
    Dim M As Integer
    M = MsgBox("Bad Array Input", vbOKOnly, "GetArraySlice2D")

End Function

回答by Lance Roberts

Below is a fast method to slice Excel variant arrays. Most of this was put together using the info from this excellent site http://bytecomb.com/vba-reference/

下面是一种对 Excel 变体数组进行切片的快速方法。其中大部分是使用来自这个优秀网站http://bytecomb.com/vba-reference/的信息组合在一起的

Essentially the destination array is pre-built as an empty 1d or 2d variant and passed to the sub with the source array and element index to be sliced. Due to the way arrays are stored in memory it's much faster to slice a column than a row as the memory layout allows a single block to be copied.

本质上，目标数组被预先构建为一个空的 1d 或 2d 变体，并与要切片的源数组和元素索引一起传递给 sub。由于数组在内存中的存储方式，因此对列进行切片比对行进行切片要快得多，因为内存布局允许复制单个块。

The good thing about this is it scales well beyond the Excel row limit.

这样做的好处是它可以远远超出 Excel 行限制。

Option Explicit

#If Win64 Then
    Public Const PTR_LENGTH As Long = 8
    Public Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long
    Public Declare PtrSafe Sub Mem_Copy Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
    Private Declare PtrSafe Function VarPtrArray Lib "VBE7" Alias "VarPtr" (ByRef Var() As Any) As LongPtr
    Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    Private Declare PtrSafe Sub FillMemory Lib "kernel32" Alias "RtlFillMemory" (Destination As Any, ByVal Length As Long, ByVal Fill As Byte)
#Else
    Public Const PTR_LENGTH As Long = 4
    Public Declare Function GetTickCount Lib "kernel32" () As Long
    Public Declare Sub Mem_Copy Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
    Private Declare Function VarPtrArray Lib "VBE7" Alias "VarPtr" (ByRef Var() As Any) As LongPtr
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    Private Declare Sub FillMemory Lib "kernel32" Alias "RtlFillMemory" (Destination As Any, ByVal Length As Long, ByVal Fill As Byte)
#End If

Private Type SAFEARRAYBOUND
    cElements    As Long
    lLbound      As Long
End Type

Private Type SAFEARRAY_VECTOR
    cDims        As Integer
    fFeatures    As Integer
    cbElements   As Long
    cLocks       As Long
    pvData       As LongPtr
    rgsabound(0) As SAFEARRAYBOUND
End Type

Sub SliceColumn(ByVal idx As Long, ByRef arrayToSlice() As Variant, ByRef slicedArray As Variant)
'slicedArray can be passed as a 1d or 2d array
'sliceArray can also be part bound, eg  slicedArray(1 to 100) or slicedArray(10 to 100)
Dim ptrToArrayVar As LongPtr
Dim ptrToSafeArray As LongPtr
Dim ptrToArrayData As LongPtr
Dim ptrToArrayData2 As LongPtr
Dim uSAFEARRAY As SAFEARRAY_VECTOR
Dim ptrCursor As LongPtr
Dim cbElements As Long
Dim atsBound1 As Long
Dim elSize As Long

    'determine bound1 of source array (ie row Count)
    atsBound1 = UBound(arrayToSlice, 1)
    'get pointer to source array Safearray
    ptrToArrayVar = VarPtrArray(arrayToSlice)
    CopyMemory ptrToSafeArray, ByVal ptrToArrayVar, PTR_LENGTH
    CopyMemory uSAFEARRAY, ByVal ptrToSafeArray, LenB(uSAFEARRAY)
    ptrToArrayData = uSAFEARRAY.pvData
    'determine byte size of source elements
    cbElements = uSAFEARRAY.cbElements

    'get pointer to destination array Safearray
    ptrToArrayVar = VarPtr(slicedArray) + 8 'Variant reserves first 8bytes
    CopyMemory ptrToSafeArray, ByVal ptrToArrayVar, PTR_LENGTH
    CopyMemory uSAFEARRAY, ByVal ptrToSafeArray, LenB(uSAFEARRAY)
    ptrToArrayData2 = uSAFEARRAY.pvData

    'determine elements size
    elSize = UBound(slicedArray, 1) - LBound(slicedArray, 1) + 1
    'determine start position of data in source array
    ptrCursor = ptrToArrayData + (((idx - 1) * atsBound1 + LBound(slicedArray, 1) - 1) * cbElements)
    'Copy source array to destination array
    CopyMemory ByVal ptrToArrayData2, ByVal ptrCursor, cbElements * elSize

End Sub

Sub SliceRow(ByVal idx As Long, ByRef arrayToSlice() As Variant, ByRef slicedArray As Variant)
'slicedArray can be passed as a 1d or 2d array
'sliceArray can also be part bound, eg  slicedArray(1 to 100) or slicedArray(10 to 100)
Dim ptrToArrayVar As LongPtr
Dim ptrToSafeArray As LongPtr
Dim ptrToArrayData As LongPtr
Dim ptrToArrayData2 As LongPtr
Dim uSAFEARRAY As SAFEARRAY_VECTOR
Dim ptrCursor As LongPtr
Dim cbElements As Long
Dim atsBound1 As Long
Dim i As Long

    'determine bound1 of source array (ie row Count)
    atsBound1 = UBound(arrayToSlice, 1)
    'get pointer to source array Safearray
    ptrToArrayVar = VarPtrArray(arrayToSlice)
    CopyMemory ptrToSafeArray, ByVal ptrToArrayVar, PTR_LENGTH
    CopyMemory uSAFEARRAY, ByVal ptrToSafeArray, LenB(uSAFEARRAY)
    ptrToArrayData = uSAFEARRAY.pvData
    'determine byte size of source elements
    cbElements = uSAFEARRAY.cbElements

    'get pointer to destination array Safearray
    ptrToArrayVar = VarPtr(slicedArray) + 8 'Variant reserves first 8bytes
    CopyMemory ptrToSafeArray, ByVal ptrToArrayVar, PTR_LENGTH
    CopyMemory uSAFEARRAY, ByVal ptrToSafeArray, LenB(uSAFEARRAY)
    ptrToArrayData2 = uSAFEARRAY.pvData

    ptrCursor = ptrToArrayData + ((idx - 1) * cbElements)
    For i = LBound(slicedArray, 1) To UBound(slicedArray, 1)

        CopyMemory ByVal ptrToArrayData2, ByVal ptrCursor, cbElements
        ptrCursor = ptrCursor + (cbElements * atsBound1)
        ptrToArrayData2 = ptrToArrayData2 + cbElements
    Next i

End Sub

Example usage:

用法示例：

Sub exampleUsage()
Dim sourceArr() As Variant
Dim destArr As Variant
Dim sliceIndex As Long

    On Error GoTo Err:

    sourceArr = Sheet1.Range("A1:D10000").Value2
    sliceIndex = 2 'Slice column 2 / slice row 2

    'Build target array
    ReDim destArr(20 To 10000) '1D array from row 20 to 10000
'    ReDim destArr(1 To 10000) '1D array from row 1 to 10000
'    ReDim destArr(20 To 10000, 1 To 1) '2D array from row 20 to 10000
'    ReDim destArr(1 To 10000, 1 To 1) '2D array from row 1 to 10000

    'Slice Column
    SliceColumn sliceIndex, sourceArr, destArr

    'Slice Row
    ReDim destArr(1 To 4)
    SliceRow sliceIndex, sourceArr, destArr

Err:
    'Tidy Up See ' http://stackoverflow.com/questions/16323776/copy-an-array-reference-in-vba/16343887#16343887
    FillMemory destArr, 16, 0

End Sub

Timings were on an old dual core CPU using the following test

使用以下测试在旧的双核 CPU 上进行计时

Sub timeMethods()
Const trials As Long = 10
Const rowsToCopy As Long = 1048576
Dim rng As Range
Dim Arr() As Variant
Dim newArr As Variant
Dim newArr2 As Variant
Dim t As Long, t1 As Long, t2 As Long, t3 As Long
Dim i As Long

    On Error GoTo Err

    'Setup Conditions 1time only
    Sheet1.Cells.Clear
    Sheet1.Range("A1:D1").Value = Split("A1,B1,C1,D1", ",") 'Strings
'    Sheet1.Range("A1:D1").Value = Split("1,1,1,1", ",") 'Longs
    Sheet1.Range("A1:D1").AutoFill Destination:=Sheet1.Range("A1:D" & rowsToCopy), Type:=xlFillDefault

    'Build source data
    Arr = Sheet1.Range("A1:D" & rowsToCopy).Value
    Set rng = Sheet1.Range("A1:D" & rowsToCopy)

    'Build target container
    ReDim newArr(1 To rowsToCopy)
    Debug.Print "Trials=" & trials & " Rows=" & rowsToCopy
    'Range
    t3 = 0
    For t = 1 To trials
        t1 = GetTickCount

            For i = LBound(newArr, 1) To UBound(newArr, 1)
                newArr(i) = rng(i, 2).Value2
            Next i

        t2 = GetTickCount
        t3 = t3 + (t2 - t1)
        Debug.Print "Range: " & t2 - t1
    Next t
    Debug.Print "Range Avg ms: " & t3 / trials

    'Array
    t3 = 0
    For t = 1 To trials
        t1 = GetTickCount

            For i = LBound(newArr, 1) To UBound(newArr, 1)
                newArr(i) = Arr(i, 2)
            Next i

        t2 = GetTickCount
        t3 = t3 + (t2 - t1)
        Debug.Print "Array: " & t2 - t1
    Next t
    Debug.Print "Array Avg ms: " & t3 / trials

    'Index
    t3 = 0
    For t = 1 To trials
        t1 = GetTickCount

            newArr2 = WorksheetFunction.Index(rng, 0, 2) 'newArr2 2d

        t2 = GetTickCount
        t3 = t3 + (t2 - t1)
        Debug.Print "Index: " & t2 - t1
    Next t
    Debug.Print "Index Avg ms: " & t3 / trials

    'CopyMemBlock
    t3 = 0
    For t = 1 To trials
        t1 = GetTickCount

            SliceColumn 2, Arr, newArr

        t2 = GetTickCount
        t3 = t3 + (t2 - t1)
        Debug.Print "CopyMem: " & t2 - t1
    Next t
    Debug.Print "CopyMem Avg ms: " & t3 / trials

Err:
    'Tidy Up
    FillMemory newArr, 16, 0


End Sub

回答by Oorang

Two things, VBA doesn't support array slicing so whatever you use, you'll have to roll your own. But since this is just for Excel, you can use the build in worksheet function index for array slicing.

两件事，VBA 不支持数组切片，所以无论你使用什么，你都必须自己动手。但由于这仅适用于 Excel，您可以使用内置的工作表函数索引进行数组切片。

Sub Test()
    'All example return a 1 based 2D array.
    Dim myArr As Variant 'This var must be generic to work.
    'Get whole range:
    myArr = ActiveSheet.UsedRange
    'Get just column 1:
    myArr = WorksheetFunction.Index(ActiveSheet.UsedRange, 0, 1)
    'Get just row 5
    myArr = WorksheetFunction.Index(ActiveSheet.UsedRange, 5, 0)
End Sub

回答by BitCoinBetter

Lance's solution has a bug in that it does not respect an offset start value with a sub-arry of unspecified length, I also found how it works quite confusing. I offer a (hopefully) more transparent solution below.

Lance 的解决方案有一个错误，即它不尊重具有未指定长度的子数组的偏移起始值，我还发现它的工作原理非常混乱。我在下面提供了一个（希望）更透明的解决方案。

Public Function GetSubTable(vIn As Variant, Optional ByVal iStartRow As Integer, Optional ByVal iStartCol As Integer, Optional ByVal iHeight As Integer, Optional ByVal iWidth As Integer) As Variant
    Dim vReturn As Variant
    Dim iInRowLower As Integer
    Dim iInRowUpper As Integer
    Dim iInColLower As Integer
    Dim iInColUpper As Integer
    Dim iEndRow As Integer
    Dim iEndCol As Integer
    Dim iRow As Integer
    Dim iCol As Integer

    iInRowLower = LBound(vIn, 1)
    iInRowUpper = UBound(vIn, 1)
    iInColLower = LBound(vIn, 2)
    iInColUpper = UBound(vIn, 2)

    If iStartRow = 0 Then
        iStartRow = iInRowLower
    End If
    If iStartCol = 0 Then
        iStartCol = iInColLower
    End If

    If iHeight = 0 Then
        iHeight = iInRowUpper - iStartRow + 1
    End If
    If iWidth = 0 Then
        iWidth = iInColUpper - iStartCol + 1
    End If

    iEndRow = iStartRow + iHeight - 1
    iEndCol = iStartCol + iWidth - 1

    ReDim vReturn(1 To iEndRow - iStartRow + 1, 1 To iEndCol - iStartCol + 1)

    For iRow = iStartRow To iEndRow
        For iCol = iStartCol To iEndCol
            vReturn(iRow - iStartRow + 1, iCol - iStartCol + 1) = vIn(iRow, iCol)
        Next
    Next

    GetSubTable = vReturn
End Function

回答by Vikas Gautam

Here is one other way.

这是另一种方式。

This is not multidimensional but would work single row and single column.

这不是多维的，但可以单行单列工作。

f and t parameters are Zero based.

f 和 t 参数是基于零的。

Function slice(ByVal arr, ByVal f, ByVal t)
    slice = Application.Index(arr, Evaluate("Transpose(Row(" & f + 1 & ":" & t + 1 & "))"))
End Function

回答by Ben

Here's a nifty function I wrote to subset a 2d array

这是我写的一个漂亮的函数来对二维数组进行子集

Function Subset2D(arr As Variant, Optional rowStart As Long = 1, Optional rowStop As Long = -1, Optional colIndices As Variant) As Variant
    'Subset a 2d array (arr)
    'If rowStop = -1, all rows are returned
    'colIndices can be provided as a variant array like Array(1,3)
    'if colIndices is not provided, all columns are returned

    Dim newarr() As Variant, newRows As Long, newCols As Long, i As Long, k As Long, refCol As Long

    'Set the correct rowStop
    If rowStop = -1 Then rowStop = UBound(arr, 1)

    'Set the colIndices if they were not provided
    If IsMissing(colIndices) Then
        ReDim colIndices(1 To UBound(arr, 2))
        For k = 1 To UBound(arr, 2)
            colIndices(k) = k
        Next k
    End If

    'Get the dimensions of newarr
    newRows = rowStop - rowStart + 1
    newCols = UBound(colIndices) + 1
    ReDim newarr(1 To newRows, 1 To newCols)

    'Loop through each empty element of newarr and set its value
    For k = 1 To UBound(newarr, 2) 'Loop through each column
        refCol = colIndices(k - 1) 'Get the corresponding reference column
        For i = 1 To UBound(newarr, 1) 'Loop through each row
            newarr(i, k) = arr(i + rowStart - 1, refCol) 'Set the value
        Next i
    Next k

    Subset2D = newarr
End Function

回答by Paulo Buchsbaum

There is no direct slicefunction for arrays, different from many other recent languages.

slice与许多其他最近的语言不同，数组没有直接的函数。

However, there is a short code snippet very handy for this. Below, a complete solution for 1D arrays:

但是，有一个简短的代码片段非常方便。下面是一维数组的完整解决方案：

'*************************************************************
'*                      Fill(N1,N2)
'* Create 1 dimension array with values from N1 to N2 step 1
'*************************************************************
Function Fill(N1 As Long, N2 As Long) As Variant
 Dim Arr As Variant
 If N2 < N1 Then
   Fill = False
   Exit Function
 End If
 Fill = WorksheetFunction.Transpose(Evaluate("Row(" & N1 & ":" & N2 & ")"))
End Function

'**********************************************************************
'*                        Slice(AArray, [N1,N2])
'* Slice an array between indices N1 to N2
'***********************************************************************
Function Slice(VArray As Variant, Optional N1 As Long = 1, Optional N2 As Long = 0) As Variant
 Dim Indices As Variant
 If N2 = 0 Then N2 = UBound(VArray)
 If N1 = LBound(VArray) And N2 = UBound(VArray) Then
   Slice = VArray
 Else
   Indices = Fill(N1, N2)
   Slice = WorksheetFunction.Index(VArray, 1, Indices)
 End If
End Function

For testing

用于检测

Var V As Variant
V = Fill(100,109)
PrintArr(Slice(V,3,5))

'************************************************
'*                 PrintArr(VArr)
'* Print the array VARR
'**************************************************
Function PrintArr(VArray As Variant)
 Dim S As String
 S = Join(VArray, ", ")
 MsgBox (S)
End Function

The results

结果

102, 103, 104 

回答by Joe

You can use a combination of the Rows, Columns, Offset and Resize properties to get a subset of a range.

您可以组合使用 Rows、Columns、Offset 和 Resize 属性来获取范围的子集。

For example if you have a range that is 5 columns by 3 rows:

例如，如果您的范围是 5 列 x 3 行：

Set rng = Range("A1:E3")

You can get any subset by appropriately combining the above properties. For example, if you want to get the rightmost 3 cells on the second row (i.e. "C2:E2" in the above example), you could do something like:

您可以通过适当组合上述属性来获得任何子集。例如，如果您想获得第二行最右边的 3 个单元格（即上例中的“C2:E2”），您可以执行以下操作：

   Set rngSubset = rng.Rows(2).Offset(0, rng.Columns.Count - 3).Resize(1, 3)

You could then wrap this up in a VBA function.

然后，您可以将其封装在 VBA 函数中。