vba Excel 正则表达式宏将搜索一列的匹配项，将所有匹配项的整行粘贴到另一个工作表中
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/18796382/
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
Excel regular expression macro that will search one column for matches, paste the entire row of all matches in another worksheet
提问by Tom Enns
I need to be able to use regular expressions in an excel macro that will search through a specific column, and then copy and paste all the rows that contain matches into a new sheet.
我需要能够在 excel 宏中使用正则表达式来搜索特定列，然后将所有包含匹配项的行复制并粘贴到新工作表中。
I have found a script that will search through columns and will paste the matches into a new sheet, but I'm not certain how to modify it use regular expressions instead of a single string.
我找到了一个可以搜索列并将匹配项粘贴到新工作表中的脚本，但我不确定如何使用正则表达式而不是单个字符串来修改它。
I'm thinking of using this macro to search, but I need to modify the term 'mail box' to be a regular expression term/object, but I'm not sure how to integrate that.
我正在考虑使用这个宏进行搜索，但我需要将术语“邮箱”修改为正则表达式术语/对象，但我不确定如何集成它。
Sub SearchForString()
Dim LSearchRow As Integer
Dim LCopyToRow As Integer
On Error GoTo Err_Execute
'Start search in row 4
LSearchRow = 4
'Start copying data to row 2 in Sheet2 (row counter variable)
LCopyToRow = 2
While Len(Range("A" & CStr(LSearchRow)).Value) > 0
'If value in column E = "Mail Box", copy entire row to Sheet2
If Range("E" & CStr(LSearchRow)).Value = "Mail Box" Then
'Select row in Sheet1 to copy
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
Selection.Copy
'Paste row into Sheet2 in next row
Sheets("Sheet2").Select
Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
ActiveSheet.Paste
'Move counter to next row
LCopyToRow = LCopyToRow + 1
'Go back to Sheet1 to continue searching
Sheets("Sheet1").Select
End If
LSearchRow = LSearchRow + 1
Wend
'Position on cell A3
Application.CutCopyMode = False
Range("A3").Select
MsgBox "All matching data has been copied."
Exit Sub
Err_Execute:
MsgBox "An error occurred."
End Sub
回答by Tim Williams
Sub SearchForString()
Dim RE As Object
Dim LSearchRow As Long
Dim LCopyToRow As Long
On Error GoTo Err_Execute
Set RE = CreateObject("vbscript.regexp")
RE.Pattern = "(red|blue)"
RE.Ignorecase = True
LSearchRow = 4 'Start search in row 4
LCopyToRow = 2 'Start copying data to row 2 in Sheet2 (row counter variable)
While Len(Cells(LSearchRow, "A").Value) > 0
If RE.Test(Cells(LSearchRow, "E").Value) Then
ActiveSheet.Rows(LSearchRow).Copy Sheets("Sheet2").Rows(LCopyToRow)
LCopyToRow = LCopyToRow + 1 'Move counter to next row
End If
LSearchRow = LSearchRow + 1
Wend
Range("A3").Select 'Position on cell A3
MsgBox "All matching data has been copied."
Exit Sub
Err_Execute:
MsgBox "An error occurred."
End Sub
回答by Gary's Student
Without major changes to your existing sub. Replace:
无需对您现有的 sub 进行重大更改。代替：
If Range("E" & CStr(LSearchRow)).Value = "Mail Box" Then
with:
和：
v = Range("E" & CStr(LSearchRow)).Value
If InStr(1, v, "red") > 0 Or InStr(1, v, "blue") > 0 Then
