0

我需要扫描“主”工作表中的所有行，在“状态”列中找到任何值为“已发货”的单元格，然后将每一整行剪切并粘贴到另一张工作表中。粘贴的行也需要放在最后一行之后。

我发现了这篇文章（粘贴在下面），我对其进行了一些修改以成功删除行。但我不知道如何移动行。我应该尝试一种全新的方法吗？

Sub DeleteRows()

    Dim rng As Range
    Dim counter As Long, numRows as long        

        With ActiveSheet
           Set rng = Application.Intersect(.UsedRange, .Range("C:C"))
        End With
        numRows = rng.Rows.Count

        For counter = numRows to 1 Step -1 
         If Not rng.Cells(counter) Like "AA*" Then
            rng.Cells(counter).EntireRow.Delete
         End If
       Next

End Sub

我不知道VBA。由于我短暂的编程历史，我只是有点理解它。我希望没关系，感谢您的帮助。

4

2 回答 2

0

有几种方法可以做到这一点，您可以在顶部列中添加过滤器，按“已发货”的值过滤吗？是否需要复制并粘贴到新工作表中？

这不是最简洁的代码，但它可能有效

    sub Shipped_filter()
dim wsSheet as worksheet
dim wsOutputSheet as worksheet
dim BottomRow as integer

Set wsSheet = worksheets("Sheet1") 'change to the sheet name
set wsOutputSheet = worksheets("Sheet2") 'change to the sheet name

'*****************************
'* Delete old data on Sheet2 *
'*****************************
wsoutputsheet.activate
Activesheet.cells.clearall

wsSheet.range("A1").select
selection.autofilter

BottomRow = wsSheet.range("A90000").end(xlup).row ' or another column you guarantee will always have a value

activesheet.range("$A$1:$Z$"&BottomRow).AutoFilter field:=1, Criteria1:="Shipped" ' change field to whatever column number Status is in

'********************************
'* Error trap in case no update *
'********************************

if activesheet.range("A90000").end(xlup).row = 1 then
 msgbox("Nothing to ship")
exit sub
end if


wsSheet.range("A1:Z"&Bottomrow).select
selection.copy

wsOutputSheet.range("A1").select
selection.pastespecial Paste:=xlpastevalues
application.cutcopymode = false

msgbox('update complete')

end sub

我没试过，所以可能需要更新

于 2013-01-18T22:53:47.803 回答
0

我最终将最初使用的代码（在此处找到）与 AutoFilter 宏（在此处找到）组合在一起。这可能不是最有效的方法，但它现在有效。如果有人知道我如何仅使用 For 循环或仅使用 AutoFilter 方法，那就太好了。这是我的代码。我应该进行任何编辑吗？

Sub DeleteShipped()

Dim lastrow As Long
Dim rng As Range
Dim counter As Long, numRows As Long

    With Sheets("Master")

        'Check for any rows with shipped
        If .Range("R:R").Find("Shipped", , xlValues, xlWhole, , , False) Is Nothing Then
            MsgBox "No shipped plates found. ", , "No Rows Moved": Exit Sub
        Else

            Application.ScreenUpdating = False

            'Copy and paste rows
            lastrow = .Range("A" & Rows.Count).End(xlUp).Row
            lastrow2 = Worksheets("ShippedBackup").Cells(Rows.Count, "A").End(xlUp).Row + 1
            .Range("A1:U" & lastrow).AutoFilter field:=18, Criteria1:="Shipped"
            .Range("A2:U" & lastrow).SpecialCells(xlCellTypeVisible).EntireRow.Copy
            Sheets("ShippedBackup").Range("A" & lastrow2).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, False, False
            .ShowAllData

            'Delete rows with shipped status
            Set rng = Application.Intersect(.UsedRange, .Range("R:R"))
            numRows = rng.Rows.Count

            For counter = numRows To 1 Step -1
             If rng.Cells(counter) Like "Shipped" Then
                rng.Cells(counter).EntireRow.Delete
             End If
            Next

            MsgBox "All shipped records have been moved to the ""ShippedBackup"" worksheet.", , "Backup Complete"

        End If
End With

希望它可以帮助某人！

于 2013-01-22T15:36:27.247 回答