Arrays 从主数组中获取某些行以插入到另一个数组中以复制到目标工作表中

我有一个大的电子表格，可以解析成其他的电子表格。我有些东西在工作，虽然很慢

我读到使用数组是一种更好的方法

如何从主数组中获取某些行，并将它们插入另一个数组，以便在末尾复制到目标工作表中

以下是原始的工作功能：

私有函数copyValue（rngSource作为范围，rngTarget作为范围）
调整大小（rngSource.Rows.Count，rngSource.Columns.Count）。Value=rngSource.Value
端函数
私人功能度假村（FROMSHEET作为变体，Column作为变体，TOSHEET作为变体，EXTRA1作为变体，EXTRA2作为变体，EXTRA3作为变体）
集合i=图纸（从图纸）
设置e=图纸（TOSHEET）
暗淡的
Dim j
暗q
d=1
j=2
e、 挑选
单元格。选择
选择，清楚
i、 挑选
第（1）行。复制
e、 挑选
第（1）行。粘贴特殊
直到i.i.Range（“G”和j））为空
如果i.Range（列&j）=“总计”，则
i、 挑选
第（j）行。复制
e、 挑选
第（2）行。特殊粘贴
'复制值i.行（j），e.行（2）
退出Do
如果结束
j=j+1
环
d=2
j=2
直到i.i.Range（“G”和j））为空
如果i.Range（Column&j）=TOSHEET或i.Range（Column&j）=EXTRA1或i.Range（Column&j）=EXTRA2或i.Range（Column&j）=EXTRA3，则
d=d+1
复制值i.Range（i.Cells（j，1），i.Cells（j，11）），e.Range（e.Cells（d，1），e.Cells（d，11））'e.Range（“A”&d）
如果i.Range（“A”&j）=e.Range（“A”&d）和i.Range（“i”&j）=总计，则
d=d+1
e、 挑选
第（2）行。复制
第（d）行。特殊粘贴
'复制值e.行（2），e.行（d）
如果结束
j=j+1
环
e、 挑选
第（2）行。删除
范围（“A1”）。选择
端函数

以下是我正在尝试的内容，其中有许多不同的尝试：

Private Function restors2（FROMSHEET作为变量，Column作为变量，TOSHEET作为变量，EXTRA1作为变量，EXTRA2作为变量，EXTRA3作为变量）
'集合i=图纸（从图纸）
'设置e=图纸（TOSHEET）
暗淡的
Dim j尽可能长
我想我会坚持多久
暗k一样长
Dim myarray作为变体
Dim arrTO As变体
d=1
j=1
“myarray=工作表（FROMSHEET）。范围（“a1”）。调整大小（10,20）
myarray=工作表（FROMSHEET）。范围（“a1:z220”）。值“调整大小”（10,20）
对于i=1到UBound（myarray）
如果myarray（i，9）=TOSHEET，则
'arrTO=myarray
'Worksheets（TOSHEET）.Range（“A”&j）.Resize（1,20）=Application.WorksheetFunction.Transpose（myarray（i））
工作表（TOSHEET）.Range（“A”&j）.Value=Application.WorksheetFunction.Transpose（myarray）
“arrTO=j”应用程序.WorksheetFunction.Index（myarray，0，1）
j=j+1
如果结束
下一个
工作表（TOSHEET）。范围（“a1”）。调整大小（10,20）=arrTO
端函数

第一次编辑
我试着清理：

Private Function RESORT（FROMSHEET作为变体，Column作为变体，TOSHEET作为变体，EXTRA1作为变体，EXTRA2作为变体，EXTRA3作为变体）
设置FRO=图纸（FROMSHEET）
设置太多=工作表（TOSHEET）
太暗了
暗淡无光
暗淡全行
TotalRow=2
太多=2
FRO_IND=2
太清楚了
TOO.Rows（1）.Value=FRO.Rows（1）.Value
直到IsEmpty（从范围（“G”和TotalRow））
如果FRO.Range（Column&TotalRow）=“Total”，则
从前面选择
行（TotalRow）。复制
太好了。选择
第（2）行。特殊粘贴
'CopyValues FRO.Rows（j），TOO.Rows（2）
退出Do
如果结束
TotalRow=TotalRow+1
环
直到空为止（从范围（“G”和从IND））
如果前向范围（列和前向IND）=TOSHEET或前向范围（列和前向IND）=EXTRA1或前向范围（列和前向IND）=EXTRA2或前向范围（列和前向IND）=EXTRA3，则
太独立=太独立+1
TOO.Rows（TOO_IND）.Value=FRO.Rows（FRO_IND）.Value
如果从范围（“A”和从索引）=太范围（“A”和从索引）和从范围（“I”和从索引）=总计
太独立=太独立+1
太好了。选择
第（2）行。复制
行（太独立）。粘贴特殊
'TOO.Rows（TOO_IND）.PasteSpecial=FRO.Rows（2）.PasteSpecial'这不起作用，我需要格式和公式，如果我只是这样做的话。公式它不起作用
如果结束
FRO_IND=FRO_IND+1
环
太多。行（2）。删除
'范围（“A1”）。选择
端函数

速度较慢（在我最小的样本集上为3.2秒，而在2.86秒）

我认为阵列将是解决方案。我在同一个样本集上多次运行此例程，但使用不同的限定符，如果主要是将样本集转储到一个数组中，然后将此数组传递给此排序例程，我认为这样会更快。我仍然不知道如何在数组上执行操作，特别是在数组之间复制一行

第二次编辑
我现在更接近了！曾经需要133秒的时间，现在只需要10.51秒

有一段时间我还在努力整理。我还没有编写任何代码来获取数组一次，然后将数组传递给RESORT函数，我正在研究下一步，看看这是否有助于加快速度

是否有方法将公式和值复制到同一数组中？我不喜欢我做这件事的方式，但它确实管用

Private Function RESORT（FROMSHEET作为变体，Column作为变体，TOSHEET作为变体，EXTRA1作为变体，EXTRA2作为变体，EXTRA3作为变体）
设置FRO=图纸（FROMSHEET）
设置太多=工作表（TOSHEET）
暗淡全行
TotalRow=2
太多=2
FRO_IND=2
Di
OPTION EXPLICIT
Private Function RESORT(FROMSHEET As Variant, Column As Variant, TOSHEET As Variant, EXTRA1 As Variant, EXTRA2 As Variant, EXTRA3 As Variant)
'Actually indicate variable types.
dim i as worksheet, dim e as worksheet
dim searchRange as Range

Set i = Sheets(FROMSHEET)
Set e = Sheets(TOSHEET)


Dim d as long
Dim j as long
dim lastRow as long 'Using a meaningful variable name
d = 1
j = 2

'I'm assuming you were using PasteSpecial because you only want values.
'I removed your unnecessary selects
e.Cells.Clear
'Move values directly instead of copy paste
i.Rows(1).value = e.Rows(1).value

'Check the first range
If Not IsEmpty(.Range("G" & j)) Then
    'Determine the last row to check.
    'This would break if j is equivalent to the last possible row... 
    'but only an example
    If IsEmpty(.Range("G" & j+1) then
        lastRow = j
    else 
        lastrow = i.Range("G" & j).End(xlDown).Row
    end if
    'Get the search Range
    'We might have used arrays here but it's less complicated to 
    ' use built in functions.
    Set searchRange = i.Range(i.Range(Column & j), _
                      i.Range(Column, lastrow).Find("Total"))
    If Not (searchRange Is Nothing) Then
        'Copy the values of the found row.
        e.Rows(2).value = searchRange.EntireRow.value
    End If
End If

myArray = i.Range("A1:B10")
MsgBox myArray(10, 2) 'Displays value of B10 (10th row, 2nd column)
MsgBox i.Cells(10, 2) 'Displays value of B10 (10th row, 2nd column)