请发布VBA代码。
我们将在包含 17 列的 Excel 工作表中获得报告,我想在 sheet1 中的“K”列中匹配字符串模式后取出项目。
以下是“K”列项目的示例
女主角
我是英雄,我是零,我是恶棍
英雄
恶棍
女主角
我是英雄,我是零,我是恶棍
恶棍,女主角
英雄,恶棍
Actor
零
我是英雄,我是零
现在我已将过滤器应用于“K”列,然后->文本过滤器->包含->然后给定模式 *hero*zero*(它选择包含英雄和零的所有字符串)。
以下是上述操作的录制宏。
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
现在我得到的结果是(在同一张表(sheet1)的“K”列中)
我是英雄,我是零,我是恶棍
我是英雄,我是零,我是恶棍
我是英雄,我是零
我希望 VBA 代码执行上述操作,并且我希望 Sheet2 中的上述结果(它应该包含 17 列,在 sheet1 中)。
请在上面帮助我。
提前致谢。
最佳答案
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
关于Excel工作表中列中字符串模式匹配的VBA代码,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/9319128/