Private Sub RegExp_GetNeedData()

     Dim RegExp As Object
     Dim SearchRange As Range, Cell As Range

     '此处定义正则表达式
     Set RegExp = CreateObject("vbscript.regexp")

     '需要重新定义的地方在这里
     keyword = "keyword"
     n =
     RangeVar = "D1:D100"

     RegExp.Pattern = keyword
     '此处指定查找范围
     Set SearchRange = ActiveSheet.Range(RangeVar)
     Dim i As Integer
      To n
       Cells(, n + i + ) = Cells(, i)
     Next
     Line =
     '遍历查找范围内的单元格
     For Each Cell In SearchRange
         cloumn = Cell.Column
         Set Matches = RegExp.Execute(Cell.Value)
          Then
             )
             Dim j As Integer
              To n
               Cells(Line, n + j + ) = Cells(Cell.Row, j)
             Next
             Line = Line +
         End If
     Next

 End Sub