在Excel工作表中的列中匹配字符串模式的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

，现在我得到的结果是（在同一表的列“K”（工作表Sheet1））

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

我想VBA代码来执行上述动作，我想以上的结果（IT方面应包含17列，它们位于Sheet2的Sheet1中）。
请在上述帮助我。
在此先感谢。

来源

2012-02-16 neobee

+1采取的努力改善问题的建议:) – 2012-02-17 00:58:34

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

来源

2012-02-17 00:57:45

感谢Siddarth，这是工作的罚款。感谢您宝贵的时间 – neobee 2012-02-17 22:14:04

我不能调试代码的权利，但这样的事情应该做的：

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

来源

2012-02-17 00:09:21 Aprillion

+1非常接近实际的解决方案:) – 2012-02-17 01:02:58

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

回答

相关问题