Excel表中列中字符串模式匹配的VBA代码

Question

请张贴VBA代码。

我们将在Excel中得到17列的报告，在sheet1中的“K”列中匹配字符串模式后，我要取出项目。

下面是列“K”项的示例

女英雄

我是英雄，我是零，我是恶棍

英雄

反派

女英雄

我是英雄，我是零，我是恶棍

恶棍，女英雄

英雄，恶棍

演员

零

我是英雄，我是零

现在，我已经将过滤器应用于列'K‘，然后->文本筛选器->包含->然后给定模式*英雄*零*(它选择包含英雄&零的所有字符串)。

下面是为上述操作录制的宏。

Sub Macro1()  
'  
' Macro1 Macro  
'  

'
    Columns("H:H").Select  
    Selection.AutoFilter  
    ActiveSheet.Range("$H$1:$H$12").AutoFilter Field:=1, Criteria1:= _  
        "=****hero*zero****", Operator:=xlAnd  
End Sub

现在我得到的结果是(在同一张纸(Sheet1)的“K”栏中)

我是英雄，我是零，我是恶棍

我是英雄，我是零，我是恶棍

我是英雄，我是零

我希望VBA代码执行上面的操作，我希望上面的结果(它应该包含sheet1中的17列)在Sheet2中。

请在上面帮助我。

提前谢谢。

Answer 1

现在你的问题更有意义了:)

试试下面的。

试用并测试了

Option Explicit

Sub Sample()
    Dim ws As Worksheet
    Dim LastRowWs As Long
    Dim Rng As Range

    '~~> Set your Input Sheet
    Set ws = Sheets("Sheet1")

    '~~> Get the lastrow in Sheet1
    LastRowWs = ws.Cells.Find(What:="*", After:=ws.Range("A1"), _
    SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

    '~~> Filter the Range
    ws.Range("A1:K" & LastRowWs).AutoFilter Field:=11, Criteria1:= _
    "=*hero*zero*", Operator:=xlAnd

    With ws.AutoFilter.Range
        On Error Resume Next
        '~~> Set the copy range [17 to include all 17 columns]
        Set Rng = .Offset(1, 0).Resize(.Rows.Count - 1, 17) _
                   .SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
    End With

    '~~> There is no match found
    If Rng Is Nothing Then
        MsgBox "There is no data which matches the '*hero*zero*' criteria"
        Exit Sub
    End If

    '~~> Prepare sheet 2 for output
    Sheets("Sheet2").Cells.Clear

    '~~> Copy the cells
    Rng.Copy Sheets("Sheet2").Range("A1")

    '~~> Remove autofilter from Input sheet
    ws.AutoFilterMode = False
End Sub

Answer 2

我现在不能调试代码，但是这样的代码应该可以：

Sub filter_and_copy()   
    Sheets("Sheet1").Range("K1").AutoFilter Field:=1, Criteria1:= _  
        "=*hero*zero*", Operator:=xlAnd 
    Sheets("Sheet1").Range("A:R").SpecialCells(xlvisible).Copy Destination:= _
        Sheets("Sheet2").Range("A1")
End Sub