2

我需要能够在将搜索特定列的 excel 宏中使用正则表达式，然后将包含匹配项的所有行复制并粘贴到新工作表中。

我找到了一个脚本，它将搜索列并将匹配项粘贴到新工作表中，但我不确定如何使用正则表达式而不是单个字符串来修改它。

我正在考虑使用此宏进行搜索，但我需要将术语“邮箱”修改为正则表达式术语/对象，但我不确定如何集成它。

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
4

2 回答 2

3 
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
于 2013-09-13T23:51:07.210 回答
0

无需对现有子进行重大更改。代替：

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
于 2013-09-13T23:42:52.177 回答