如何在 VBA 中批量切片数组

Question

假设我有一个带有 X 值的 VBA 一维数组（或字典或集合）。我需要以 Y 为单位对这些值执行操作。

所以如果 X = 55 和 Y = 25，我需要循环 3 次：

1. 选择值 1 到 25 并执行操作
2. 选择 26 到 50 的值并执行操作
3. 选择最后 5 个值并执行操作

任何具有良好性能的想法将不胜感激:)

编辑：

我想出了下面的代码。虽然看起来不是很简洁，但它可以工作

Sub test()

Dim arr As Variant
Dim temparr As Variant
Dim sippno As Integer
Dim loopend As Integer
Dim loopstart As Integer
Dim batchsize As Integer
Dim i As Integer

'Storing main array with all values

arr = Sheet1.Range("A1:A" & Sheet1.Range("A" & Rows.Count).End(xlUp).Row).Value

'Setting count of values, batch size and starting step for loop

sippno = WorksheetFunction.CountA(arr)
loopstart = 1
batchsize = 10

Do Until sippno = 0

If sippno < batchsize Then
loopend = loopstart + sippno - 1
Else
loopend = loopstart + batchsize - 1
End If

ReDim temparr(loopstart To loopend)

For i = loopstart To loopend

temparr(i) = WorksheetFunction.Index(arr, i, 0)

sippno = sippno - 1

Next

loopstart = loopend + 1

'Action to be performed with batch of values stored in second array

Debug.Print WorksheetFunction.TextJoin(", ", True, temparr)

Loop

End Sub

Answer 1

二维数组因为懒得编码一维但与一维相同的想法：

Sub test()
    arr = Sheet3.Range("A1").CurrentRegion.Value2
    x = UBound(arr)
    y = 5
    jj = y
    
    For j = 1 To UBound(arr)
        sumaction = sumaction + arr(j, 1)
        If (UBound(arr) - jj) < 0 Then
            jj = UBound(arr)
            sumaction = 0
        End If
        If j = jj Then
            dosomething = sumaction * 2
            sumaction = 0
            jj = jj + y
        End If
    Next j
End Sub

Answer 2

Option Explicit
Sub splice()

    Const batch = 10
   
    Dim data, ar()
    Dim lastrow As Long, n As Long, i As Long
    Dim j As Long, r As Long
   
    With Sheet1
        lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
        data = .Range("A1:A" & lastrow).Value2
    End With
    i = Int(lastrow / batch)
   
    For n = 0 To i
        r = batch
        If n = i Then
            r = lastrow Mod batch
        End If
        If r > 0 Then
            ReDim ar(r - 1)
            For j = 1 To r
                ar(j - 1) = data(j + n * batch, 1)
            Next
            ' do something
            Debug.Print Join(ar, ",")
        End If
    Next
End Sub

Answer 3

通过Application.Index()切片

为了艺术，我在这篇后期文章中演示了如何将一个“垂直”数组一次性分批分成几个“平面”数组，例如10 个元素。

这种方法受益于高级重新排列功能和pecularities of Application.Index() 允许将整个行/列数数组作为参数传递；这里足以满足所需行号的垂直数组，例如通过Application.Index(data, Evaluate("Row(11:20)"), 0) 仅过滤第 11 到 20 行。 .. c.f.见第 2 a) 节

补充说明：

• 评估表格行公式是获取连续行号的一种快速方法。
• 转置函数结果将数组维度更改为一维数组
• 通过 ReDim Preserve ar(0 To UBound(ar) - 1) 将数组 boundaries 减少 -1 会生成一个从零开始的数组（可选）

Option Explicit
Sub splice()
    Const batch = 10        ' act in units of 10 elements
    With Sheet1         
        '1) get data (1-based 2-dim array)
        Dim lastRow As Long
        lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
        Dim data: data = .Range("A1:A" & lastRow).Value2
        '2) slice
        Dim i As Long, nxt As Long, ar As Variant
        For i = 1 To UBound(data) Step batch
            nxt = Application.min(i + batch - 1, UBound(data))
            '2a) assign sliced data to 1- dim array (with optional redim to 0-base)
            With Application
                ar = .Transpose(.Index(data, Evaluate("row(" & i & ":" & nxt & ")")))
            End With
            'optional redimming to zero-base
            ReDim Preserve ar(0 To UBound(ar) - 1)  
            
            '2b) perform some action
            Debug.Print _
                "batch " & i \ batch + 1 & ": " & _
                "ar(" & LBound(ar) & " To " & UBound(ar) & ") ~~> " & _
                Join(ar, "|")
        Next
    End With
End Sub

切片一个“平面”一维数组

但是，如果您想对 1-dim 数组进行切片，例如字典键，转置数据输入即可：data = Application.Transpose(...)