Excel 范围太大时生成范围数组

我有一个宏，它获取一列并将其拆分为多个444行的列，因为我的最大范围是444行。然后，我如何迭代每一列并分配一个范围（理想情况下使用相同的名称，但采用数组格式）

我也愿意放弃拆分列的想法，只需要为每444行创建一个类似于

的内容，然后为rng.arry中的每个rng创建

更新：基本上我有一行有1000个值。我想要一个范围数组，格式如下：

rng(0) = A1:A444
rng(1) = A445:A889
rng(2) = A890:A1000

然后我可以像这样循环每个rng：

For each rng in rng.array
   ... Do Stuff
End For

下面是我必须拆分列的内容，但我查找了范围数组，却找不到任何内容

 Sub Four_Hundred_Fourty_Four_Split_Sub()
Dim lastRow As Long, copynumRow As Long
Dim cRow As Long, cCol As Long
Dim wb As Workbook, ws As Worksheet
Dim rng As Range

If IsEmpty(urng) = False Then
Debug.Print urng
Set urng = Application.InputBox("Select a range", "Obtain Range Object", Type:=8)
End If
Set rng = Range(Col_Letter(urng.Column) & "1:" & Col_Letter(urng.Column) & Cells(Rows.Count, urng.Column).End(xlUp).Row)

Set wb = ActiveWorkbook
Set sSheet = ActiveSheet

WorksheetCreate ("444_Split")
Set ws = wb.Worksheets("444_Split")
sSheet.Select


rng.Copy Destination:=ws.Range(Col_Letter(urng.Column) & "1:" & Col_Letter(urng.Column) & Cells(Rows.Count, urng.Column).End(xlUp).Row)

Application.ScreenUpdating = False

copynumRow = 444
cCol = 2
cRow = 1 + copynumRow

With ws
    lastRow = .Range("A" & .Rows.Count).End(xlUp).Row

    Do While cRow <= lastRow
        .Range("A" & cRow).Resize(copynumRow, 1).Cut _
            Destination:=.Cells(1, cCol).Resize(copynumRow, 1)

        cRow = cRow + copynumRow
        cCol = cCol + 1
    Loop
End With

Application.ScreenUpdating = True

ws.Select

End Sub

Sub-Four\u-hu-Fourty\u-Four\u-Split\u-Sub（）
将最后一行变暗为长，将copynumRow变暗为长
乌鸦一样长，卷心菜一样长
将wb设置为工作簿，ws设置为工作表
变暗rng As范围
如果IsEmpty（urng）=False，则
调试。打印urng
设置urng=Application.InputBox（“选择范围”，“获取范围对象”，类型：=8）
如果结束
设置rng=范围（列（urng.Column）和“1:”&列（urng.Column）和单元格（Rows.Count，urng.Column）.结束（xlUp）.Row）
设置wb=ActiveWorkbook
设置sSheet=ActiveSheet
工作表创建（“444_分割”）
设置ws=wb.工作表（“444_分割”）
sSheet.Select
rng.Copy Destination:=ws.Range（列（urng.Column）&“1:”&列（urng.Column）&单元格（Rows.Count，urng.Column）.End（xlUp）.Row）
Application.ScreenUpdating=False
copynumRow=444
cCol=2
cRow=1+copynumRow
与ws
lastRow=.Range（“A”&.Rows.Count）.End（xlUp）.Row
我画了一些东西，对你的例子很有用。我已经添加了一些注释来解释，但还没有完全测试

我建议使用更有意义的变量名等

这将生成一个范围数组，然后可以将其传输回工作表

Sub x()

Dim r As Range, rStart As Range
Dim n As Long, i As Long, j As Long
Dim r1() As Range

n = 444

Set r = Range("A1:A1000")
ReDim r1(1 To WorksheetFunction.Ceiling(r.Count / n, 1)) 'work out how many groups of 444

For i = 1 To UBound(r1)
    Set rStart = r.Cells((i - 1) * n + 1) 'starting cell of each array element
    If r(r.Rows.Count).Row - rStart.Row < n Then    'check if less than 444 rows left
        j = r(r.Rows.Count).Row - rStart.Row + 1
    Else
        j = n
    End If
    Set r1(i) = rStart.Resize(j) 'expand group to full size and add to array
    Debug.Print r1(i).Address
Next i

End Sub

subx（）
变暗r为范围，r为范围
n一样长，i一样长，j一样长
变暗r1（）作为范围
n=444
设置r=范围（“A1:A1000”）
重拨r1（1到工作表function.天花（r.Count/n，1））'计算出444个组的数量
对于i=1至UBound（r1）
设置rStart=r.Cells（（i-1）*n+1）每个数组元素的起始单元格
如果r（r.Rows.Count）.Row-rStart.Row
我画了一些东西，对你的例子很有用。我已经添加了一些注释来解释，但还没有完全测试

我建议使用更有意义的变量名等

这将生成一个范围数组，然后可以将其传输回工作表

Sub x()

Dim r As Range, rStart As Range
Dim n As Long, i As Long, j As Long
Dim r1() As Range

n = 444

Set r = Range("A1:A1000")
ReDim r1(1 To WorksheetFunction.Ceiling(r.Count / n, 1)) 'work out how many groups of 444

For i = 1 To UBound(r1)
    Set rStart = r.Cells((i - 1) * n + 1) 'starting cell of each array element
    If r(r.Rows.Count).Row - rStart.Row < n Then    'check if less than 444 rows left
        j = r(r.Rows.Count).Row - rStart.Row + 1
    Else
        j = n
    End If
    Set r1(i) = rStart.Resize(j) 'expand group to full size and add to array
    Debug.Print r1(i).Address
Next i

End Sub

subx（）
变暗r为范围，r为范围
n一样长，i一样长，j一样长
变暗r1（）作为范围
n=444
设置r=范围（“A1:A1000”）
重拨r1（1到工作表function.天花（r.Count/n，1））'计算出444个组的数量
对于i=1至UBound（r1）
设置rStart=r.Cells（（i-1）*n+1）每个数组元素的起始单元格
如果r（r.Rows.Count）.Row-rStart.Row
下面是我在上面代码的底部使用的方法，但我并不认为这是最好的方法

WS.Select
Call FindLast(WS)

Dim rcell As Range

Set rng = Application.ActiveSheet.Range("A1:" & lColLet & "1")

For Each rcell In rng.Cells
 If Not IsError(rcell.Value) Then
  If rcell.Value <> "" Then
    Set IDRng = WS.Range(rcell.Address, rcell.End(xlDown))
    Call PasteInWV
  End If
 End If
Next rcell

Application.ScreenUpdating = True

WS.Select
调用FindLast（WS）
变暗rcell As范围
Set rng=Application.ActiveSheet.Range（“A1:&lColLet&“1”）
对于rng.单元格中的每个rcell
如果不是IsError（rcell.Value），则
如果rcell.Value为“”，则
设置IDRng=WS.Range（rcell.Address，rcell.End（xlDown））
调用PasteInWV
如果结束
如果结束
下一个rcell
Application.ScreenUpdating=True
下面是我在上面代码的底部使用的方法，但我并不认为这是最好的方法

WS.Select
Call FindLast(WS)

Dim rcell As Range

Set rng = Application.ActiveSheet.Range("A1:" & lColLet & "1")

For Each rcell In rng.Cells
 If Not IsError(rcell.Value) Then
  If rcell.Value <> "" Then
    Set IDRng = WS.Range(rcell.Address, rcell.End(xlDown))
    Call PasteInWV
  End If
 End If
Next rcell

Application.ScreenUpdating = True

WS.Select
调用FindLast（WS）
变暗rcell As范围
Set rng=Application.ActiveSheet.Range（“A1:&lColLet&“1”）
对于rng.单元格中的每个rcell
如果不是IsError（rcell.Value），则
如果rcell.Value为“”，则
设置IDRng=WS.Range（rcell.Address，rcell.End（xlDown））
调用PasteInWV
如果结束
如果结束
下一个rcell
Application.ScreenUpdating=True
请也测试下一个代码。在新的空表上测试它，它将为您选择的列构建1000行的测试范围，并从第5列开始在其他列中返回每个数组范围：

Sub testRangesArray()
  Dim sh As Worksheet, arrR As Variant, lastRow As Long, Lcol As String, splitVal As Long
  Dim i As Long, k As Long, rng As Range
  
  Set sh = ActiveSheet
  Lcol = "B" 'Column to be processed/tested letter
  'Create a test range in the test column________________________________________________
    With sh.Range(Lcol & "2:" & Lcol & 3)
        .Value = Application.Transpose(Array(1, 2))
        .AutoFill Destination:=sh.Range(Lcol & "2:" & Lcol & "1001"), Type:=xlFillDefault
    End With
  '______________________________________________________________________________________
  
  lastRow = sh.Range(Lcol & Rows.count).End(xlUp).row
  Set rng = sh.Range(Lcol & "2:" & Lcol & lastRow)
  splitVal = 444 'you may set here what you need

  ReDim arrR(WorksheetFunction.RoundUp(rng.Rows.count / splitVal, 0) - 1)
  For i = 0 To UBound(arrR)
    Set arrR(i) = Range(Lcol & IIf(i = 0, rng.Cells(1).row, splitVal * i + rng.Cells(1).row) & ":" & _
                          IIf(i = UBound(arrR), Lcol & rng.Rows.count + rng.Cells(1).row - 1, Lcol & _
                                                            splitVal * (i + 1) + rng.Cells(1).row - 1))
  Next i
  'Drop the array ranges values in columns, starting from the 5th one:
  For i = 0 To UBound(arrR)
    sh.Cells(1, 5 + i).Resize(arrR(i).Rows.count, 1).Value = arrR(i).Value
  Next
End Sub

请也测试下一个代码。在新的空表上测试它，它将为您选择的列构建1000行的测试范围，并从第5列开始在其他列中返回每个数组范围：

Sub testRangesArray()
  Dim sh As Worksheet, arrR As Variant, lastRow As Long, Lcol As String, splitVal As Long
  Dim i As Long, k As Long, rng As Range
  
  Set sh = ActiveSheet
  Lcol = "B" 'Column to be processed/tested letter
  'Create a test range in the test column________________________________________________
    With sh.Range(Lcol & "2:" & Lcol & 3)
        .Value = Application.Transpose(Array(1, 2))
        .AutoFill Destination:=sh.Range(Lcol & "2:" & Lcol & "1001"), Type:=xlFillDefault
    End With
  '______________________________________________________________________________________
  
  lastRow = sh.Range(Lcol & Rows.count).End(xlUp).row
  Set rng = sh.Range(Lcol & "2:" & Lcol & lastRow)
  splitVal = 444 'you may set here what you need

  ReDim arrR(WorksheetFunction.RoundUp(rng.Rows.count / splitVal, 0) - 1)
  For i = 0 To UBound(arrR)
    Set arrR(i) = Range(Lcol & IIf(i = 0, rng.Cells(1).row, splitVal * i + rng.Cells(1).row) & ":" & _
                          IIf(i = UBound(arrR), Lcol & rng.Rows.count + rng.Cells(1).row - 1, Lcol & _
                                                            splitVal * (i + 1) + rng.Cells(1).row - 1))
  Next i
  'Drop the array ranges values in columns, starting from the 5th one:
  For i = 0 To UBound(arrR)
    sh.Cells(1, 5 + i).Resize(arrR(i).Rows.count, 1).Value = arrR(i).Value
  Next
End Sub

为什么“我的最大射程是444行”？你能更好地（用语言）解释一下你想要完成什么吗？尝试一下，请编辑您的问题，并向我们展示一张图片（如果不是可编辑的），说明现状，另一张图片说明您需要完成的任务。看来很难理解你的需要。至少，对我来说……你所说的“数组格式”是什么意思？你想要实际数组而不是单元格范围吗？实际上，你使用
rng（0）=A1:A444
表明你想要一个范围数组。当前代码有什么问题？它是否出错或不执行您想要的操作？@SJR我以前有过此代码，当时我手动执行此操作，并使用此代码生成一个WS，每个列的最大值为444，但很好的一点是，我可能可以在
do While
循环中调整我需要的内容。我会在发布更新/答案后给出答案。我在问为什么需要“最大444行”，以便一起寻找其他替代方案。。。关于制作一个范围数组，它并没有那么复杂。我昨晚（晚上在我的国家）做了一次这样的潜水艇，只是为了好玩，但我想了解哪一个是你的目标会很好，而不是你可能会达到的一步