如何在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

通过Application.Index()进行切片

只是为了美术的缘故，我在这篇后期的文章中演示了如何将一个"垂直"数组一次性分割成几个"平面"数组，例如10个元素。

这种方法得益于对的高级重排。的特性,Application.Index()的特性允许传递整个行/列数数组作为参数;这里满足所需行号的垂直数组，例如，通过Application.Index(data, Evaluate("Row(11:20)"), 0)仅过滤11至20行。. .C.f.参见第2节a)

进一步指出:

• 计算表格行公式是获得连续行号的一种快速方法。
• 转置函数结果将数组尺寸更改为1-dim数组
• 通过ReDim Preserve ar(0 To UBound(ar) - 1)将数组边界减少-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

对'flat' 1-dim数组进行切片

然而，如果你想切片一个1-dim的数组，比如字典键，它足以调换数据输入:data = Application.Transpose(...)

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

2d数组，因为延迟编码1d，但与1d相同的想法:

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