vba Excel工作表中一列中字符串模式匹配的VBA代码
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/9319128/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
VBA code for string pattern match in a column in Excel sheet
提问by neobee
Please post the VBA code.
请发布VBA代码。
We will get Report in Excel sheet consting of 17 columns and i want to take out items after matching string pattern in column 'K' in sheet1.
我们将在 17 列的 Excel 工作表中获得报告，我想在匹配 sheet1 中“K”列中的字符串模式后取出项目。
Below is the sample of column 'K' items
以下是“K”列项目的示例
heroine
I am hero, I am zero, I am villan
hero
villan
heroine
I am hero, I am zero, I am villan
villan, heroine
hero, villan
actor
zero
I am hero, I am zero
女主角
我是英雄我是零我是反派
英雄
反派
女主角
我是英雄我是零我是反派
反派
英雄女主角反派
演员
零
我是英雄我是零
Now i have applied filter to column 'K' and then->text filter-> contains->then given pattern *hero*zero*(which selects all strings which contains hero & zero).
现在我已将过滤器应用于列 'K' 然后->文本过滤器->包含->然后给定模式 *hero*zero*（它选择包含 hero 和零的所有字符串）。
Below is the recorded macro for above action.
以下是上述操作的录制宏。
Sub Macro1()
'
' Macro1 Macro
'
'
Columns("H:H").Select
Selection.AutoFilter
ActiveSheet.Range("$H:$H").AutoFilter Field:=1, Criteria1:= _
"=****hero*zero****", Operator:=xlAnd
End Sub
And now the result i got is ( in column 'K' of same sheet(sheet1) )
现在我得到的结果是（在同一张表（sheet1）的“K”列中）
I am hero, I am zero, I am villan
I am hero, I am zero, I am villan
I am hero, I am zero
我是英雄我是零我是反派
我是英雄我是零我是反派
我是英雄我是零
I want VBA code to perform above action and i want the above result( it should contains 17 columns, which are in sheet1) in Sheet2.
Please help me on the above.
Thanks in Advance.
我希望 VBA 代码执行上述操作，并且我希望在 Sheet2 中得到上述结果（它应该包含 17 列，在 sheet1 中）。
请帮我解决上面的问题。
提前致谢。
回答by Siddharth Rout
neobee, Now your question makes more sense :)
neobee，现在你的问题更有意义:)
Try the below.
试试下面的。
TRIED AND TESTED
久经考验
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
回答by Aprillion
I can't debug the code right now, but something like this should do:
我现在无法调试代码，但应该这样做：
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
