Excel工作表中的列中的string模式的VBA代码匹配

请张贴VBA代码。

我们将得到报表Excel表单中的17列，并且我想在匹配的表单中的'K'列中的string模式后的项目。

以下是K列项目的样本

女英雄
我是英雄，我是零，我是别人
英雄
恶棍
女英雄
我是英雄，我是零，我是别人
别人，女主angular
英雄，别墅
演员
零
我是英雄，我是零

现在我已经应用filter列'K'，然后 – >文本filter – >包含 – >然后给出模式*英雄*零*（select所有包含英雄和零的string）。

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

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 

而现在我得到的结果是（在同一张（表1）的'K'栏）

我是英雄，我是零，我是别人
我是英雄，我是零，我是别人
我是英雄，我是零

---

我想VBA代码执行上述操作，我想在Sheet2中的上述结果（它应该包含17列，这是Sheet1中）。
请帮助我上面。
提前致谢。

Answer 1

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

试试下面。

尝试和testing

 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

我现在无法debugging代码，但是应该这样做：

 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