Excel正则expression式macros将search一列中的匹配项，将所有匹配的整行粘贴到另一个工作表中

我需要能够在Excelmacros中使用正则expression式来search特定列，然后将包含匹配的所有行复制并粘贴到新工作表中。

我发现了一个脚本，将通过列search，将粘贴到一个新的表，但我不知道如何修改它使用正则expression式，而不是一个单一的string。

我正在考虑使用这个macros来search，但我需要修改“邮箱”这个术语是一个正则expression式的术语/对象，但我不知道如何整合它。

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 

Answer 1

 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 

Answer 2

没有重大改变你现有的子。 更换：

 If Range("E" & CStr(LSearchRow)).Value = "Mail Box" Then 

有：

 v = Range("E" & CStr(LSearchRow)).Value If InStr(1, v, "red") > 0 Or InStr(1, v, "blue") > 0 Then