Question

请发布VBA代码。

我们将在Excel工作表中获得17列的报表，并且我希望在sheet1中的列'K'中匹配字符串模式后取出项目。

以下是“K”项列

的示例

女主角
我是英雄，我是零，我是别墅英雄
恶棍
女主角
我是英雄，我是零，我是别墅维拉恩，女主人公英雄，别墅演员
零
我是英雄，我是零

现在我已将过滤器应用于列'K'，然后 - >＆gt;文本过滤器 - ＆gt; contains-＆gt;然后给出pattern * hero * zero *（选择包含hero＆amp; 0的所有字符串）。

以下是上述操作的录制宏。

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

现在我得到的结果是（在同一张纸的'K'栏中（sheet1））

我是英雄，我是零，我是别墅我是英雄，我是零，我是别墅我是英雄，我是零

我希望VBA代码执行上述操作，我希望Sheet2中的上述结果（它应包含17列，在sheet1中）。
请帮我解决上述问题在此先感谢。

Answer 1

neobee，现在你的问题更有意义了：）

尝试以下内容。

已经过测试

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

用于字符串模式的VBA代码匹配Excel工作表中的列

2 个答案: