Question

我想搜索一列“C”，如果单词的第一个字母不是以A或M开头，那么我想复制整行并将其粘贴到新创建的工作表中，相同的格式。我还想将剩余的行复制到另一个新的工作表中。

这是我使用过的代码并引用了几个来源，但我无法获得所需的结果。到目前为止，我只能创建新的工作表，并将其复制到工作表“已拒绝”，但它会复制所有内容，而且标准似乎不起作用。

Sub sortfunds()

Worksheets.Add(Before:=Worksheets(Worksheets.Count)).Name = "Rejected"
Worksheets.Add(Before:=Worksheets(Worksheets.Count)).Name = "Accepted"

Dim wRejected As Worksheet
Dim wAccepted As Worksheet
Dim ws As Worksheet
Dim LastRow As Long
Dim i As Long
Dim j As Long
*'j is for 'Accepted' worksheet which I have not worked on yet*

Set ws = ActiveSheet
Set wRejected = ThisWorkbook.Sheets("Rejected")
Set wAccepted = ThisWorkbook.Sheets("Accepted")

With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With

LastRow = Range("C" & Rows.Count).End(xlUp).Row

With ws
    For i = LastRow To 1 Step -1
        If Left(Range("C" & LastRow), 1) <> "A" And Left(Range("C" & LastRow), 1) <> "M" Then Rows(i).Copy wRejected.Rows(wRejected.Cells(wRejected.Rows.Count, 3).End(xlUp).Row + 1)
    Next i
End With

With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With

End Sub

Answer 1

您总是检查最后一行中的值，而不是依次处理每一行。

变化：

If Left(Range("C" & LastRow), 1) <> "A" And Left(Range("C" & LastRow), 1) <> "M"

为：

If Left(Range("C" & i), 1) <> "A" And Left(Range("C" & i), 1) <> "M"

如果满足多个条件，VBA会将行复制到新创建的工作表

1 个答案: