在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代碼

回答

相關問題