如何在Excel VBA中切片数组？

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

Answer 1

Application.WorksheetFunction.Index（数组，行，列）

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

例：

Application.WorksheetFunction.Index（array，0，3）

这会给你整个第三列。

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

限制 ：如果您使用较新版本的Excel，则WorksheetFunction.Index可以处理的数组大小是有限制的。 如果array超过65,536行或65,536列，则会引发“types不匹配”错误。 如果这是你的问题，那么看到这个更复杂的答案 ，不受同样的限制。

以下是我写的用于完成所有一维和二维切片的function：

 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 

Answer 2

以下是切片Excel变体arrays的快速方法。 大多数这是放在一起使用这个优秀的网站http://bytecomb.com/vba-reference/

本质上，目标数组是预先构build为空的1d或2d变体，并传递给具有源数组和元素索引的子进行切片。 由于数组存储在内存中的方式，因为内存布局允许复制单个块，所以分割列的速度要快于行的速度。

关于这一点的好处是，它的规模远远超出了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 

用法示例：

 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 

计时器在使用以下testing的旧双核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 

Answer 3

有两件事情，VBA不支持数组切片，所以无论你使用什么，你都必须自己动手。 但是因为这只是针对Excel，所以可以使用工作表函数索引中的构build来进行数组切片。

 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 

Answer 4

兰斯的解决scheme有一个错误，因为它不尊重偏移的开始值与未指定的长度子，我也发现它是如何工作相当混乱。 我提供了一个（希望）下面更透明的解决scheme。

 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 

Answer 5

这是另一种方式。

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

f和t参数是基于零的。

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

Answer 6

这是一个很好的函数，我写了一个二维数组的子集

 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 

Answer 7

您可以使用“行”，“列”，“偏移”和“resize”属性的组合来获取范围的子集。

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

 Set rng = Range("A1:E3") 

您可以通过适当组合上述属性来获取任何子集。 例如，如果你想获得第二行最右边的3个单元（例如上例中的“C2：E2”），你可以这样做：

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

你可以把它包装在一个VBA函数中。