VBA過濾剪切和粘貼

Question

一般來說，我是宏和 VBA 的新手。 只是試圖自動化一些過濾，這將節省我大量的時間。 我一直在嘗試使用 excel 中的宏來選擇數據，按某些條件過濾（下面我將它放在一個過濾器上以方便）剪切，然后粘貼到新工作表。 我希望它也刪除我從中剪切的空行。 下面的代碼只復制不刪除。

Sub filtertest()
Dim LastRow As Long

Sheets("Sheet1").Cells.Clear
Sheets("Sheet2").Activate

'Find the last row
LastRow = Range("A1").CurrentRegion.Rows.Count

'Select Table
Range("A1:K" & LastRow).Select

'Filter table
Selection.AutoFilter Field:=1, Criteria1:="51192"

'Copy/Paste
Selection.Copy
Sheets("Sheet1").Range("A1").PasteSpecial xlPasteValues

'Turn off autofilter
Selection.Autofilter

End Sub

我還嘗試將一些其他代碼組合在一起以將它們組合在一起。 但是，我不斷收到有關對象的錯誤。 不確定是因為“sub button_click()”還是我所說的我是新手。 任何幫助表示贊賞。 謝謝！

Sub Button1_Click()

Application.ScreenUpdating = False
Columns(1).AutoFilter 1, "51192"
With Range("a1", Range("i" & Rows.Count).End(3))
    .Copy FalsePositives.Cells(Rows.Count, 1).End(3).Offset(1)
    .EntireRow.Delete
End With
Columns(1).AutoFilter
Application.ScreenUpdating = True

End Sub

Answer 1

復制並粘貼值，然后返回並刪除原始文件，跳過標題。

Sub filtertest()
    Dim LastRow As Long

    Worksheets("Sheet1").Cells.Clear

    With Worksheets("Sheet2")

        'Find the last row
        LastRow = .Range("A1").CurrentRegion.Rows.Count

        'Filter table
        .Range("A1:K" & LastRow).AutoFilter Field:=1, Criteria1:="51192"


        'Copy/Paste
        .Range("A1:K" & LastRow).SpecialCells(xlCellTypeVisible).Copy
        Worksheets("Sheet1").Range("A1").PasteSpecial xlPasteValues

        'remove originals
        .Range("A1:K" & LastRow).Offset(1, 0).EntireRow.Delete

        'Turn off autofilter
        .AutoFilterMode = False
    End With
End Sub

Answer 2

我是論壇的新手。 我向大家打招呼。 我找到了您的過濾器並根據特定需要對其進行了修改。 我所做的是創建一個名為 AUXILIAR 的工作表，以復制應用的過濾器。 標准是ALTA這個詞。 我的問題如下。 每次放ALTA這個詞，文檔就滯后； 也就是說，它不鎖定，但寫ALTA這個詞需要時間。

我留下修改后的代碼，以便您可以閱讀它並幫助我找出為什么它滯后和變慢。

謝謝你們。

代碼

Sub FiltroAvanzado()
 
'Nombramos las variables
 Dim UltimaFila As Long
 Dim UltimaFilaAuxiliar As Long
 
 
 With Worksheets("TRAFICO")

        'Encuentra la ultima fila
        UltimaFila = .Range("A3").CurrentRegion.Rows.Count

        'Filtra Tabla
        .Range("A2:I" & UltimaFila).AutoFilter Field:=9, Criteria1:="ALTA"
        
        
       
        
        'Copia/Pega
        .Range("A3:I" & UltimaFila).SpecialCells(xlCellTypeVisible).Copy
        
         UltimaFilaAuxiliar = Sheets("AUXILIAR").Columns("A").Find("*", _
         searchorder:=xlByRows, searchdirection:=xlPrevious).Row
         Worksheets("AUXILIAR").Range("A" & UltimaFilaAuxiliar + 1).PasteSpecial xlPasteValues

        'Remueve los valores originales
        .Range("A2:I" & UltimaFila).Offset(1, 0).EntireRow.Delete

        'Apaga el Auto Filtro
        .AutoFilterMode = False
    End With


End Sub

Answer 3

我發現了這個小論壇，我真的很喜歡它。 我能和你一起學習。 使用你的方法，但根據我的需要修改它。 我只有一個問題，我不知道如何解決。

我有 2 張工作表，一張是數據，另一張是我復制舊數據的地方，我保存了它。 我用ALTA這個詞過濾。

我的問題是，當我寫 ALTA 這個詞時，excel 需要時間，它不會鎖定，它很慢或滯后。 我留下代碼讓他們理解並告訴我怎么做，這樣當我寫ALTA這個詞時，excel就不會滯后。

我還想告訴你，我把代碼放在一個插件中，並在功能區上添加了一個按鈕，以便它在我需要的時候執行代碼。

你好。

Sub FiltroAvanzado()

Dim UltimaFila As Long Dim UltimaFilaAuxiliar As Long

'Esta instruccion limpia la hora a donde se enviaran los datos
'desactivamos la intruccion para otra ocacion
'Worksheets("AUXILIAR").Cells.Clear

With Worksheets("TRAFICO")

    'Encuentra la ultima fila
    UltimaFila = .Range("A3").CurrentRegion.Rows.Count

    'Filtra Tabla
    .Range("A2:I400" & UltimaFila).AutoFilter Field:=9, Criteria1:="ALTA"
    
    
   
    
    'Copia/Pega
    .Range("A3:I" & UltimaFila).SpecialCells(xlCellTypeVisible).Copy
    
     UltimaFilaAuxiliar = Sheets("AUXILIAR").Columns("A").Find("*", _
     searchorder:=xlByRows, searchdirection:=xlPrevious).Row
     Worksheets("AUXILIAR").Range("A" & UltimaFilaAuxiliar + 1).PasteSpecial xlPasteValues

    'Remueve los valores originales
    .Range("A2:I" & UltimaFila).Offset(1, 0).EntireRow.Delete

    'Apaga el Auto Filtro
    .AutoFilterMode = False
End With

結束子