使用 vba 过滤和删除 excel 中的行 - 宏

Question

i have used the below script. Which deletes the rows not present in the filter condition. I have tried the below code but still not able to achieve it,

Dim a As String
a = ComboBox1.Value
End Sub

Private Sub CommandButton1_Click()

Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim wsfilter As Worksheet
Dim CopyLastRow As Integer
Dim DestlastRow As Integer
Dim ws As Worksheet, rng As Range, LstRw As Long

    '1. open the workbook to copy from
    Workbooks.Open "C:\dd\Imports PY Plan Forecast.xlsx"
     '2. Define each workbook
    Set wsCopy = ThisWorkbook.Sheets("Input Data")
    Set wsDest = Workbooks("Imports PY Plan Forecast.xlsx").Sheets("Source")
    Set wsfilter = ThisWorkbook.Sheets("HR - Source")
    Set wsfilter2 = ThisWorkbook.Sheets("HR - Main Page")
    '3. Define last row in source data
    CopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
    
'Filter column A and column B based on value



wsDest.Range("A1:H" & CopyLastRow).AutoFilter Field:=3, Criteria1:=wsfilter2.Range("B3").Value
wsDest.Range("A1:H" & CopyLastRow).AutoFilter Field:=5, Criteria1:=wsCopy.Range("H2").Value & "*"
Application.DisplayAlerts = False
ActiveSheet.UsedRange.Offset(1, 0).Resize(ActiveSheet.UsedRange.Rows.Count - 1).Rows.Delete
Application.DisplayAlerts = True
ThisWorkbook.Worksheets("Input Data").Range("A2:H" & CopyLastRow).SpecialCells(xlCellTypeVisible).Copy wsDest.Range("A2")

    'ThisWorkbook.Worksheets("Input Data").Range("A2:F" & CopyLastRow).Copy wsDest.Range("A2")
'3.1. Clear Filter
  On Error Resume Next
    wsDest.ShowAllData
  On Error GoTo 0
 '4. close and save source file
    
    Workbooks("Imports PY Plan Forecast.xlsx").Close SaveChanges:=True
end sub

but it is deleting the other rows which are not existing in the filter condition. Any inputs?

Answer 1

.Resize doesn't care about visibility. Assuming that you want to delete the rows that are visible under the filter conditions set, you could make a Range that is explicitly the visible cells and then delete those rows:

...
wsDest.Range("A1:H" & CopyLastRow).AutoFilter Field:=3, Criteria1:=wsfilter2.Range("B3").Value
wsDest.Range("A1:H" & CopyLastRow).AutoFilter Field:=5, Criteria1:=wsCopy.Range("H2").Value & "*"

wsDest.Range("A2:A" & CopyLastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete

wsDest.ShowAllData
...

(note that the Range to delete excludes row 1, which I guess is headers)

Answer 2

Finally, i did few research and found the soultion.

Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim wsfilter As Worksheet
Dim CopyLastRow As Integer
Dim DestlastRow As Integer
'Dim LastRow As Long

    '1. open the workbook to copy from
    Workbooks.Open "C:\Imports PY Plan Forecast.xlsx"
     '2. Define each workbook
    Set wsCopy = ThisWorkbook.Sheets("Input Data")
    Set wsDest = Workbooks("Imports PY Plan Forecast.xlsx").Sheets("Source")
    Set wsfilter = ThisWorkbook.Sheets("HR - Source")
    Set wsfilter2 = ThisWorkbook.Sheets("HR - Main Page")
    '3. Define last row in source data
    CopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
    
    Dim WS As Worksheet: Set WS = Workbooks("Imports PY Plan Forecast.xlsx").Sheets("Source")

'Filter column A and column B based on value

    Application.ScreenUpdating = False
    With WS
        .AutoFilterMode = False
       ' LastRow = .Cells(Rows.Count, 1).End(xlUp).Row
        With wsDest.Range("A2:H" & CopyLastRow) '--Assuming your header is in Row 2 and records start at Row 3.
            .AutoFilter Field:=3, Criteria1:=wsfilter2.Range("B3").Value '--Field:=3 is Column C if data starts at A
            .AutoFilter Field:=5, Criteria1:=wsCopy.Range("H2").Value & "*"
            Application.DisplayAlerts = False
            WS.ListObjects("Data").DataBodyRange.SpecialCells(xlCellTypeVisible).Delete
            Application.DisplayAlerts = True
            
        End With
        .AutoFilterMode = False
    End With
    On Error Resume Next
    wsDest.ShowAllData
    On Error GoTo 0```