搜索特定文本，一次一列，並將數據復制到另一張工作表

Question

我有一個工作表，我在其中管理費率列表。 它有兩張紙。

output 表。

它有18列。 從K到Z的列包含價目表。 在這些列中，有許多單元格包含No price value 而不是 price in $ 。

我想一一過濾列並將所有包含No price的行復制到另一張表。

我使用多個 if 語句編寫了一個宏，但沒有得到所需的 output。

Sub FilterNoPrice()
    Dim myRange As Range
    Dim myRow As Variant                '### NOTE THIS CHANGE!
    Sheets("Output").Select

    Set myRange = Range("K3:K10000")

    myRow = Application.Match("No price", myRange, False)

    If Not IsError(myRow) Then
        ActiveSheet.Range("K:K").AutoFilter Field:=1, Criteria1:="No price"
        ' and then select/activate the cell:
        'Application.GoTo Cells(1, myRow)
    Else
        ' The value is not found in the range, so inform you:
        'MsgBox "Not found!"
    End If

    Set myRange = Range("L3:L10000")
    myRow = Application.Match("No price", myRange, False)
    If Not IsError(myRow) Then
        ActiveSheet.Range("L:L").AutoFilter Field:=2, Criteria1:="No price"
        ' and then select/activate the cell:
        'Application.GoTo Cells(1, myRow)
    Else
        ' The value is not found in the range, so inform you:
        'MsgBox "Not found!"
    End If

    Set myRange = Range("M3:M10000")
    myRow = Application.Match("No price", myRange, False)
    If Not IsError(myRow) Then
        ActiveSheet.Range("M:M").AutoFilter Field:=3, Criteria1:="No price"
        ' and then select/activate the cell:
        'Application.GoTo Cells(1, myRow)
    Else
        ' The value is not found in the range, so inform you:
        MsgBox "Not found!"
    End If

    Set myRange = Range("N3:N10000")
    myRow = Application.Match("No price", myRange, False)
    If Not IsError(myRow) Then
        ActiveSheet.Range("N:N").AutoFilter Field:=4, Criteria1:="No price"
        ' and then select/activate the cell:
        'Application.GoTo Cells(1, myRow)
    Else
        ' The value is not found in the range, so inform you:
        MsgBox "Not found!"
    End If        

    Set myRange = Range("O3:O10000")
    myRow = Application.Match("No price", myRange, False)
    If Not IsError(myRow) Then
        ActiveSheet.Range("O:O").AutoFilter Field:=5, Criteria1:="No price"
        ' and then select/activate the cell:
        'Application.GoTo Cells(1, myRow)
    Else
        ' The value is not found in the range, so inform you:
        MsgBox "Not found!"
    End If        

    Set myRange = Range("P3:P10000")
    myRow = Application.Match("No price", myRange, False)
    If Not IsError(myRow) Then
        ActiveSheet.Range("P:P").AutoFilter Field:=6, Criteria1:="No price"
        ' and then select/activate the cell:
        'Application.GoTo Cells(1, myRow)
    Else
        ' The value is not found in the range, so inform you:
        MsgBox "Not found!"
    End If

    Set myRange = Range("Q3:Q10000")
    myRow = Application.Match("No price", myRange, False)
    If Not IsError(myRow) Then
        ActiveSheet.Range("Q:Q").AutoFilter Field:=7, Criteria1:="No price"
        ' and then select/activate the cell:
        'Application.GoTo Cells(1, myRow)
    Else
        ' The value is not found in the range, so inform you:
        MsgBox "Not found!"
    End If        

    Set myRange = Range("R3:R10000")
    myRow = Application.Match("No price", myRange, False)
    If Not IsError(myRow) Then
        ActiveSheet.Range("R:R").AutoFilter Field:=8, Criteria1:="No price"
        ' and then select/activate the cell:
        'Application.GoTo Cells(1, myRow)
    Else
        ' The value is not found in the range, so inform you:
        MsgBox "Not found!"
    End If

    Set myRange = Range("S3:S10000")
    myRow = Application.Match("No price", myRange, False)
    If Not IsError(myRow) Then
        ActiveSheet.Range("S:S").AutoFilter Field:=9, Criteria1:="No price"
        ' and then select/activate the cell:
        'Application.GoTo Cells(1, myRow)
    Else
        ' The value is not found in the range, so inform you:
        MsgBox "Not found!"
    End If        

    Set myRange = Range("T3:T10000")
    myRow = Application.Match("No price", myRange, False)
    If Not IsError(myRow) Then
        ActiveSheet.Range("T:T").AutoFilter Field:=10, Criteria1:="No price"
        ' and then select/activate the cell:
        'Application.GoTo Cells(1, myRow)
    Else
        ' The value is not found in the range, so inform you:
        MsgBox "Not found!"
    End If

    Set myRange = Range("U3:U10000")
    myRow = Application.Match("No price", myRange, False)
    If Not IsError(myRow) Then
        ActiveSheet.Range("U:U").AutoFilter Field:=11, Criteria1:="No price"
        ' and then select/activate the cell:
        'Application.GoTo Cells(1, myRow)
    Else
        ' The value is not found in the range, so inform you:
        MsgBox "Not found!"
    End If

    Set myRange = Range("V3:V10000")
    myRow = Application.Match("No price", myRange, False)
    If Not IsError(myRow) Then
        ActiveSheet.Range("V:V").AutoFilter Field:=12, Criteria1:="No price"
        ' and then select/activate the cell:
        'Application.GoTo Cells(1, myRow)
    Else
        ' The value is not found in the range, so inform you:
        MsgBox "Not found!"
    End If

    Set myRange = Range("W3:W10000")
    myRow = Application.Match("No price", myRange, False)
    If Not IsError(myRow) Then
        ActiveSheet.Range("W2:W10000").AutoFilter Field:=13, Criteria1:="No price"
        ' and then select/activate the cell:
        'Application.GoTo Cells(1, myRow)
    Else
        ' The value is not found in the range, so inform you:
        MsgBox "Not found!"
    End If        

    Set myRange = Range("X3:X10000")
    myRow = Application.Match("No price", myRange, False)
    If Not IsError(myRow) Then
        ActiveSheet.Range("X:X").AutoFilter Field:=14, Criteria1:="No price"
        ' and then select/activate the cell:
        'Application.GoTo Cells(1, myRow)
    Else
        ' The value is not found in the range, so inform you:
        MsgBox "Not found!"
    End If          

    Set myRange = Range("Y3:Y10000")
    myRow = Application.Match("No price", myRange, False)
    If Not IsError(myRow) Then
        ActiveSheet.Range("Y:Y").AutoFilter Field:=15, Criteria1:="No price"
        ' and then select/activate the cell:
        'Application.GoTo Cells(1, myRow)
    Else
        ' The value is not found in the range, so inform you:
        MsgBox "Not found!"
    End If          

    Set myRange = Range("Z3:Z10000")
    myRow = Application.Match("No price", myRange, False)
    If Not IsError(myRow) Then
        ActiveSheet.Range("Z:Z").AutoFilter Field:=16, Criteria1:="No price"
        ' and then select/activate the cell:
        'Application.GoTo Cells(1, myRow)
    Else
        ' The value is not found in the range, so inform you:
        MsgBox "Not found!"
    End If

End Sub

Answer 1

正如我在評論中提到的，沒有必要為每列設置單獨的過濾器代碼。 您可以只有一個范圍K:L ，然后只需在循環中更改field:=如下所示

假設您的工作表如下所示

將此代碼粘貼到Module中。 我已經對代碼進行了注釋，因此您理解它應該沒有問題。 但如果你這樣做了，那就簡單地問。

Option Explicit

Sub Sample()
    Dim ws As Worksheet, wsOutput As Worksheet
    Dim lastrow As Long, i As Long
    Dim rng As Range, rngToCopy As Range

    '~~> Change the name of the sheets as applicable
    Set ws = Sheet1
    Set wsOutput = Sheet2

    With ws
        '~~> Find Last Row in the sheet
        If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
            lastrow = .Cells.Find(What:="*", _
                          After:=.Range("A1"), _
                          Lookat:=xlPart, _
                          LookIn:=xlFormulas, _
                          SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False).Row
        Else
            MsgBox "No Data Found"
            Exit Sub
        End If

        '~~> Set your filter range
        Set rng = .Range("K2:Z" & lastrow)

        '~~> Loop through the range
        For i = 1 To rng.Columns.Count
            .AutoFilterMode = False

            '~~> Filter the range and store the filtered range
            '~~> if applicable in a range object
            With rng
                .AutoFilter Field:=i, Criteria1:="No price"

                If rngToCopy Is Nothing Then
                    Set rngToCopy = .Offset(1, 0).SpecialCells(xlCellTypeVisible)
                Else
                    Set rngToCopy = Union(rngToCopy, .Offset(1, 0).SpecialCells(xlCellTypeVisible))
                End If
            End With
        Next i

        .AutoFilterMode = False

        '~~> Clear output sheet and copy data across
        If Not rngToCopy Is Nothing Then
            wsOutput.Cells.Clear
            .Range("K2:Z2").Copy wsOutput.Cells(1, 1) '<~~ Copy Headers
            rngToCopy.Copy wsOutput.Cells(2, 1) '<~~ Copy Filtered Data
        End If
    End With
End Sub

在行動