添加到粘贴2D阵列列表

Question

我正在尝试编写一个宏，该宏在交叉引用列表中的数据集之前，以便知道要删除的数据行。该删除的数据还应将其剪切并粘贴到新的表格上，以便后来可以对其进行检查。然后，宏需要根据字符串中的某些字符删除数据列并删除行。我找到了一种方法，以及上述剪切和粘贴，在每次IF语句之后，它都将行并粘贴到另一张纸上。但是，这使宏运行时间很长。我想到将要删除的每个行添加到列表（删除2），然后将此列表粘贴到宏末端的另一张纸中，但是我无法弄清楚如何添加行并成功粘贴了数组。我还尝试在交叉引用和删除行（因此已删除列表）时尝试执行此操作。逻辑是，只有一旦数据集加快了宏，它才必须通过数据集。

我已经介入了代码，可以查看何时添加该行，它给项目提供了大量随机组件，但没有注册任何信息。如果有人对解决此问题有任何想法，或者有更好的方法来加快原始代码的速度，那么将非常感谢！

*请注意，我不得不编辑一些信息，因此在点上有怪异的标签名称。

Dim lastrow As Integer

Dim lastRowSL As Integer

Dim List1 As Object

Dim Deleted As Object

Dim Deleted2 As Object

Dim Code As String

Dim S As String


Sub Formatting()

'obtaining which securities are bonds
Workbooks.Open "File1"
        
'finding last row of the file1
lastRowSL = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

'creating the list to cross reference data against
Set List1 = CreateObject("System.Collections.ArrayList")


'adding to the list
For j = 1 To lastRowSL
    
    If Cells(j, 2) = "List" And Cells(j, 6) <> "F" Then
        S = Cells(j, 4)
        List1.Add S
    End If
       
Next j
    
Workbooks("File1.xlsx").Close savechanges:=False

ActiveWorkbook.Sheets("List").Activate

'obtaining the last row for cross referencing
lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

Set Deleted = CreateObject("System.Collections.ArrayList")
Set Deleted2 = CreateObject("System.Collections.ArrayList")

'comparing data against values earlier established to see if they can be deleted, then analsysing the data to see if they can be deleted
'trying to add these to lists and then paste them after the for loop to speed the macro up - i can't figure out how to paste the list
For k = 10 To lastrow

Code = Cells(k, 4)

'adding deleted rows into another sheet for checking
' first if checks against the earlier established l;ist, all of the below should add the data row to one of the two lists, then delete that row in the main data.
    If List1.Contains(Code) Then
        Deleted.Add Rows(k)
        Rows(k).Delete
        k = k - 1
    
    ElseIf Left(Cells(k, 2), 4) = "abcd" Then
        Deleted2.Add Rows(k)
        Rows(k).Delete
        k = k - 1
    
    ElseIf Left(Cells(k, 2), 5) = "efghi" Then
        Deleted2.Add Rows(k)
        Rows(k).Delete
        k = k - 1
    
    ElseIf Left(Cells(k, 2), 5) = "jklmn" Then
        Deleted2.Add Rows(k)
        Rows(k).Delete
        k = k - 1
 
    ElseIf Left(Cells(k, 2), 5) = "opqrs" Then
        Deleted2.Add Rows(k)
        Rows(k).Delete
        k = k - 1
     
     ElseIf Left(Cells(k, 2), 4) = "tuvwx" Then
        Deleted2.Add Rows(k)
        Rows(k).Delete
        k = k - 1
     
     ElseIf Left(Cells(k, 2), 5) = "yzabc" Then
        Deleted2.Add Rows(k)
        Rows(k).Delete
        k = k - 1
        
     ElseIf Right(Cells(k, 2), 3) = "def" Then
        Deleted2.Add Rows(k)
        Rows(k).Delete
        k = k - 1
     
    End If

Next k

'formatting data to make it easier to check
Sheets("Deleted").Activate
Range("A2") = Deleted.ToArray 'trying to paste the lists here
Range("A2:J" & lastRow2 + 1).Sort Key1:=Range("E1"), Order1:=xlAscending
Range("A:J").EntireColumn.AutoFit

Sheets("Deleted2").Activate
'code where other list will be pasted
Range("A2") = Deleted2.ToArray
Range("A2:J" & lastRow3 + 1).Sort Key1:=Range("B1"), Order1:=xlAscending
Range("A:J").EntireColumn.AutoFit

ActiveWorkbook.Sheets("List").Activate
Range("A10:J" & lastrow).Sort Key1:=Range("E9"), Order1:=xlAscending
Range("B:E").EntireColumn.AutoFit

End Sub