Excel VBA에서 어레이를 슬라이스하려면 어떻게 해야 합니까?

Excel VBA에서 어레이를 슬라이스하려면 어떻게 해야 합니까?

Excel VBA에서 어레이 슬라이스에 사용할 수 있는 기능은 무엇입니까?

어플.워크시트 기능색인(배열, 행, 열)

행 또는 열에 0 값을 지정하면 지정된 열 또는 행 전체가 표시됩니다.

예:

어플.워크시트 기능인덱스(어레이, 0, 3)

이렇게 하면 세 번째 열 전체가 표시됩니다.

행과 열을 모두 0이 아닌 것으로 지정하면 특정 요소만 가져옵니다.전체 행 또는 열보다 작은 슬라이스를 얻는 방법은 없습니다.

제한:어레이 크기에는 다음과 같은 제한이 있습니다.WorksheetFunction.Index새로운 버전의 Excel을 사용하고 있는 경우는, 에 대응합니다.한다면array65,536 행 또는 65,536 열을 초과하는 경우 "Type mismatch" 오류가 발생합니다.이것이 문제라면 같은 제한이 적용되지 않는 보다 복잡한 답변을 참조하십시오.

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

다음은 Excel 배리언트 어레이를 슬라이스하는 빠른 방법입니다.이 대부분은 이 뛰어난 사이트 http://bytecomb.com/vba-reference/의 정보를 사용하여 정리되었습니다.

기본적으로 행선지 어레이는 빈 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

다음 테스트를 사용하여 오래된 듀얼 코어 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

두 가지, 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

랜스의 솔루션은 길이가 지정되지 않은 서브아리의 오프셋 시작값을 존중하지 않는다는 버그가 있으며, 그 동작도 상당히 혼란스럽다는 것을 알게 되었습니다.아래에 좀 더 투명한 해결책을 제시하겠습니다.

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

여기 또 다른 방법이 있습니다.

이것은 다차원이 아니지만 단일 행과 단일 열이 작동합니다.

f 및 t 파라미터는 제로 베이스입니다.

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

여기 2D 어레이의 서브셋을 위해 작성한 함수가 있습니다.

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

오래된 질문이지만 범위의 1 행을 1차원 배열로 가져오려면 색인과 전치(Transpose)를 사용하면 됩니다.

Sub test()
    Dim ar1
    Dim a As Object: Set a = Application

    ar1 = a.Transpose(a.Transpose(a.Index(Range("A1:C3"), 2, 0)))  'get 2d row
    Debug.Print Join(ar1, "|")
End Sub

이것을 OFFSET과 조합하면, 행 단위로 전체 범위를 빠르게 읽어낼 수 있습니다.

인 것은 slice다른 많은 최신 언어와는 다른 어레이 기능.

단, 이 경우 매우 편리한 짧은 코드 조각이 있습니다.아래는 1D 어레이를 위한 완전한 솔루션입니다.

'*************************************************************
'*                      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

테스트용

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

결과

102, 103, 104 

행, 열, 간격띄우기 및 크기 조정 특성의 조합을 사용하여 범위의 하위 집합을 가져올 수 있습니다.

예를 들어, 5열 x 3행의 범위가 있는 경우:

Set rng = Range("A1:E3")

위의 속성을 적절히 조합하면 임의의 서브셋을 얻을 수 있습니다.예를 들어, 두 번째 행의 가장 오른쪽 3개의 셀(위의 예에서는 "C2:E2")을 가져오려면 다음과 같이 하십시오.

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

VBA 함수로 정리할 수 있습니다.

필요한 슬라이스만큼 어레이를 작성하면 됩니다.그런 다음 전체 배열에서 값을 복사하여 루프합니다.풀 어레이의 인덱스는 슬라이스가 시작되는 위치입니다(예에서는 1).따라서 전체 어레이가 ("a", "b", "c", "d")이고 "b"와 "c"가 필요한 경우:

Dim slice(1) as Variant

For i = 0 To 1
    slice(i) = fullArray( i + 1)
Next

언급URL : https://stackoverflow.com/questions/175170/how-do-i-slice-an-array-in-excel-vba