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

最初に使用していたコード (ここにあります) と 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 に答える
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 に答える