1234

ExcelHome技术论坛

用户名  找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

帖子
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 139|回复: 7

VBA正则方法分离“” 时间,天气,地点,概述,照片描述“”遇到问题。

[复制链接]

TA的精华主题

TA的得分主题

发表于 2025-1-24 10:23 | 显示全部楼层 |阅读模式
image.png



  1. Sub SeparateInfoWithRegex()
  2.     Dim allText As String
  3.     allText = "  - 时间:2025/01/23 17:30:03地点: 广东省珠海市香洲区前山街道·玖洲道购物公园天气:多云19°C,PM2.5 25,空气质量40优路段:未提及,无法确定概述:最后一次拍摄公园,或特写特别场景,如宁静角落。照片描述: 傍晚多云 " '这里需要替换为实际从文件读取的内容"
  4.    
  5.     Dim regexTime As Object
  6.     Set regexTime = CreateObject("VBScript.RegExp")
  7.     With regexTime
  8.        .Global = True
  9.        .IgnoreCase = True
  10.        .Pattern = "时间:(\d{4}/\d{2}/\d{2} \d{2}:\d{2}:\d{2})"
  11.     End With
  12.    
  13.     Dim regexWeather As Object
  14.     Set regexWeather = CreateObject("VBScript.RegExp")
  15.     With regexWeather
  16.        .Global = True
  17.        .IgnoreCase = True
  18.        .Pattern = "天气:(.+?)\r\n"
  19.     End With
  20.    
  21.     Dim regexLocation As Object
  22.     Set regexLocation = CreateObject("VBScript.RegExp")
  23.     With regexLocation
  24.        .Global = True
  25.        .IgnoreCase = True
  26.        .Pattern = "地点:(.+?)\r\n"
  27.     End With
  28.    
  29.     Dim regexOverview As Object
  30.     Set regexOverview = CreateObject("VBScript.RegExp")
  31.     With regexOverview
  32.        .Global = True
  33.        .IgnoreCase = True
  34.        .Pattern = "概述:(.+?)\r\n"
  35.     End With
  36.    
  37.     Dim regexPhotoDesc As Object
  38.     Set regexPhotoDesc = CreateObject("VBScript.RegExp")
  39.     With regexPhotoDesc
  40.        .Global = True
  41.        .IgnoreCase = True
  42.        .Pattern = "照片描述:(.+)"
  43.     End With
  44.    
  45.     Dim matchesTime As Object
  46.     Set matchesTime = regexTime.Execute(allText)
  47.     Dim matchesWeather As Object
  48.     Set matchesWeather = regexWeather.Execute(allText)
  49.     Dim matchesLocation As Object
  50.     Set matchesLocation = regexLocation.Execute(allText)
  51.     Dim matchesOverview As Object
  52.     Set matchesOverview = regexOverview.Execute(allText)
  53.     Dim matchesPhotoDesc As Object
  54.     Set matchesPhotoDesc = regexPhotoDesc.Execute(allText)
  55.    
  56.     Dim i As Long
  57.     For i = 0 To matchesTime.Count - 1
  58.         Debug.Print "时间:" & matchesTime(i).SubMatches(0)
  59.         Debug.Print "天气:" & matchesWeather(i).SubMatches(0)
  60.         Debug.Print "地点:" & matchesLocation(i).SubMatches(0)
  61.         Debug.Print "概述:" & matchesOverview(i).SubMatches(0)
  62.         Debug.Print "照片描述:" & matchesPhotoDesc(i).SubMatches(0)
  63.         Debug.Print "---------------------"
  64.     Next i
  65. End Sub
复制代码


Book2.zip

13.39 KB, 下载次数: 1

TA的精华主题

TA的得分主题

发表于 2025-1-24 11:34 | 显示全部楼层
改变了正则表达式之后,必须立即应用。
否则,多次改变再应用,只能是最后一次的正则表达式是当前有效的。
楼上的代码,最后进行提取时,只有“照片描述”的正则表达式是有效的,自然是不可能用来提取其它如时间、天气、地点等信息。

TA的精华主题

TA的得分主题

发表于 2025-1-24 12:33 | 显示全部楼层
  1. Sub SeparateInfoWithRegex()
  2.     Dim allText As String
  3.     allText = "  - 时间:2025/01/23 17:30:03地点: 广东省珠海市香洲区前山街道·玖洲道购物公园天气:多云19°C,PM2.5 25,空气质量40优路段:未提及,无法确定概述:最后一次拍摄公园,或特写特别场景,如宁静角落。照片描述: 傍晚多云 " '这里需要替换为实际从文件读取的内容"
  4.     Dim Patt(5) As String, Patterns(5) As String
  5.     Patt(0) = "时间": Patterns(0) = "\d{4}/\d{2}/\d{2} \d{2}:\d{2}:\d{2}"
  6.     Patt(1) = "天气": Patterns(1) = "[^\r\n]+"
  7.     Patt(2) = "路段": Patterns(2) = "[^\r\n]+"
  8.     Patt(3) = "地点": Patterns(3) = "[^\r\n]+"
  9.     Patt(4) = "概述": Patterns(4) = "[^\r\n]+"
  10.     Patt(5) = "照片描述": Patterns(5) = "[^\r\n]+"
  11.     Dim RegEx As Object
  12.     Set RegEx = CreateObject("VBScript.RegExp")
  13.     With RegEx
  14.         .Global = True
  15.         .IgnoreCase = True
  16.         .Pattern = "(?=" & Join(Patt, "|") & ")"
  17.         allText = .Replace(allText, vbCrLf)
  18.         On Error Resume Next
  19.         For i = 0 To 5
  20.             .Pattern = Patt(i) & ".(" & Patterns(i) & ")" '改变正则表达式
  21.             Debug.Print .Execute(allText)(0) '立即提取相应数据,作用等同下一句代码
  22.             'Debug.Print Patt(i) & ":" & .Execute(allText)(0).submatches(0)
  23.         Next
  24.     End With
  25. End Sub
复制代码

评分

1

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2025-1-24 18:40 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
本帖最后由 ning84 于 2025-1-25 08:25 编辑

谢谢解答,优化了程序。

image.png

  1. Sub ExtractInfo()
  2.     Dim InputString As String
  3.     Dim RegEx As New VBScript_RegExp_55.RegExp
  4.     Dim Matches As VBScript_RegExp_55.MatchCollection
  5.     Dim Match As VBScript_RegExp_55.Match
  6.     Dim Time As String, Location As String, Weather As String
  7.     Dim Summary As String, PhotoDescription As String
  8.    
  9.     ' 输入字符串
  10.     InputString = "时间:2025/01/23 17:30:03,天气:多云19°C,地点: 广东省珠海市,路段:未提及,概述:最后一次拍摄公园,照片描述:傍晚多云"
  11.    
  12.     ' 创建正则对象
  13.     Set RegEx = New VBScript_RegExp_55.RegExp
  14.    
  15.     ' 定义正则表达式
  16.     RegEx.Pattern = "时间:(.*?),天气:(.*?),地点: (.*?),路段:.*?,概述:(.*?),照片描述:(.*?)$"
  17.     RegEx.Global = False
  18.     RegEx.MultiLine = False
  19.    
  20.     ' 执行匹配
  21.     Set Matches = RegEx.Execute(InputString)
  22.    
  23.     ' 检查是否有匹配结果
  24.     If Matches.Count > 0 Then
  25.         Set Match = Matches(0)
  26.         
  27.         ' 提取各部分信息
  28.         Time = Match.SubMatches(0)
  29.         Location = Match.SubMatches(2)
  30.         Weather = Match.SubMatches(1)
  31.         Summary = Match.SubMatches(3)
  32.         PhotoDescription = Match.SubMatches(4)
  33.         
  34.         ' 输出结果
  35.         Debug.Print "时间: " & Time
  36.         Debug.Print "天气: " & Weather
  37.         Debug.Print "地点: " & Location
  38.         Debug.Print "概述: " & Summary
  39.         Debug.Print "照片描述: " & PhotoDescription
  40.     Else
  41.         MsgBox "未找到匹配结果!"
  42.     End If
  43. End Sub
复制代码



结果

时间: 2025/01/23 17:30:03
天气: 多云19°C
地点: 广东省珠海市
概述: 最后一次拍摄公园
照片描述: 傍晚多云

TA的精华主题

TA的得分主题

 楼主| 发表于 2025-1-25 07:59 | 显示全部楼层
学习RegEx.Pattern = "时间:(.*?)\n地点:(.*?)\n天气:(.*?)\n路段:.*?\n概述:(.*?)\n照片描述:(.*?)$"


  1. Sub ExtractInfo()
  2.     Dim Slds As Slides
  3.         Set Slds = Application.ActivePresentation.Slides
  4.         
  5.     Dim InputString As String
  6.     Dim RegEx As New VBScript_RegExp_55.RegExp
  7.     Dim Matches As VBScript_RegExp_55.MatchCollection
  8.     Dim Match As VBScript_RegExp_55.Match
  9.     Dim Time As String, Location As String, Weather As String
  10.     Dim Summary As String, PhotoDescription As String
  11.    
  12.     ' 输入字符串
  13.     'InputString = "时间:2025/01/23 17:30:03,天气:多云19°C,地点: 广东省珠海市,路段:未提及,概述:最后一次拍摄公园,照片描述:傍晚多云"
  14.     InputString = Slds(1).NotesPage.Shapes(1).TextFrame.TextRange.Text
  15.     Debug.Print InputString
  16.    
  17.     ' 创建正则对象
  18.     Set RegEx = New VBScript_RegExp_55.RegExp
  19.    
  20.     ' 定义正则表达式
  21.     RegEx.Pattern = "时间:(.*?),地点: (.*?),天气:(.*?),路段:.*?,概述:(.*?),照片描述:(.*?)$"
  22.     RegEx.Pattern = "时间:(.*?)\n地点:(.*?)\n天气:(.*?)\n路段:.*?\n概述:(.*?)\n照片描述:(.*?)$"
  23.     RegEx.Global = False
  24.     RegEx.MultiLine = False
  25.    
  26.     ' 执行匹配
  27.     Set Matches = RegEx.Execute(InputString)
  28.    
  29.     ' 检查是否有匹配结果
  30.     If Matches.Count > 0 Then
  31.         Set Match = Matches(0)
  32.         
  33.         ' 提取各部分信息
  34.         Time = Match.SubMatches(0)
  35.         Location = Match.SubMatches(2)
  36.         Weather = Match.SubMatches(1)
  37.         Summary = Match.SubMatches(3)
  38.         PhotoDescription = Match.SubMatches(4)
  39.         
  40.         ' 输出结果
  41.         Debug.Print "时间: " & Time
  42.         Debug.Print "天气: " & Weather
  43.         Debug.Print "地点: " & Location
  44.         Debug.Print "概述: " & Summary
  45.         Debug.Print "照片描述: " & PhotoDescription
  46.     Else
  47.         MsgBox "未找到匹配结果!"
  48.     End If
  49. End Sub
复制代码


时间:2025/01/23 17:39:21
地点:广东省珠海市香洲区前山街道·玖洲道购物公园
天气:多云19°C,PM2.5 25,空气质量40优
路段:未提及,无法确定
概述:傍晚时分在玖洲道购物公园拍摄,可能记录公园整体环境、建筑或人群活动。
照片描述:水印相机定格此刻,多云天气使光线柔和,19°C气温舒适,画面中或许有购物公园的建筑轮廓、往来行人与店铺灯光。
时间: 2025/01/23 17:39:21
天气: 广东省珠海市香洲区前山街道·玖洲道购物公园
地点: 多云19°C,PM2.5 25,空气质量40优
概述: 傍晚时分在玖洲道购物公园拍摄,可能记录公园整体环境、建筑或人群活动。
照片描述: 水印相机定格此刻,多云天气使光线柔和,19°C气温舒适,画面中或许有购物公园的建筑轮廓、往来行人与店铺灯光。



TA的精华主题

TA的得分主题

 楼主| 发表于 2025-1-25 23:56 | 显示全部楼层
学习学习,再学习。


  1. <font _mstmutation="1">Function SeparateInfoWithRegex(InputString, Rng As Range)
  2.     Dim RegEx As New VBScript_RegExp_55.RegExp
  3.     Dim Matches As VBScript_RegExp_55.MatchCollection
  4.     Dim Match   As VBScript_RegExp_55.Match
  5.     Dim Time As String, Location As String, Weather As String
  6.     Dim Summary As String, PhotoDescription As String
  7.     Set RegEx = New VBScript_RegExp_55.RegExp

  8.     Dim ResultDict As Scripting.Dictionary
  9.     Set ResultDict = New Scripting.Dictionary
  10.     Dim key As Variant
  11.     ' 定义正则表达式
  12.     'RegEx.Pattern = "时间:(.*?)\n地点:(.*?)\n天气:(.*?)\n路段:.*?\n概述:(.*?)\n照片描述:(.*?)$"
  13.     RegEx.Pattern = "^(时间|天气|地点|概述|照片描述):(.+?)(?=^时间|^天气|^地点|^概述|^照片描述|$)"
  14.    
  15. With RegEx
  16.         .Global = True
  17.         .MultiLine = True
  18.         .IgnoreCase = True
  19.         
  20.         ' 定义一个通用的模式来匹配所有字段
  21.         .Pattern = "^(时间|天气|地点|道路|概述|照片描述):(.+?)(?=^时间|^天气|^地点|^道路|^概述|^照片描述|$)"
  22.         
  23.         If .Test(InputString) Then
  24.             Set Matches = .Execute(InputString)
  25.             
  26.             For Each Match In Matches
  27.                 key = Trim(Match.SubMatches(0))
  28.                 ResultDict(key) = Match.SubMatches(1)
  29.             Next Match
  30.         End If
  31.         For jj = 0 To ResultDict.Count - 1
  32.              Rng(, jj + 1) = ResultDict.Items(jj)
  33.         Next jj
  34.         
  35.   End With
  36. End Function

  37. '''
  38. Sub PptNotePageToRng()
  39.     Dim Sht As Worksheet, Rng As Range
  40.         Set Sht = Sheet3
  41.         With Sht
  42.              .Cells.Clear
  43.              .Cells.Font.Size = 9
  44.              Set Rng = .Cells(5, 3)
  45.         End With
  46.    
  47.     Dim Kk As Integer
  48.         Kk = 1
  49.     Dim Pres As PowerPoint.Presentation
  50.     Dim Shp As Shape, Shps As Shapes
  51.    
  52.         Set Pres = RetuPpt
  53.     Dim Sld As Slide, Slds As Slides
  54.         Set Slds = Pres.Slides
  55.         For Each Sld In Slds
  56.               Sld.Name = "Sld" & Kk
  57.               With Sld.NotesPage
  58.                    Debug.Print Sld.Name, .Shapes.Count
  59.                    For ii = 1 To .Shapes.Count
  60.                         If InStr(.Shapes(ii).Name, "备注") > 0 Then
  61.                             'Debug.Print .Shapes(ii).TextFrame.TextRange.Text
  62.                             SeparateInfoWithRegex .Shapes(ii).TextFrame.TextRange.Text, Sht.Cells(Kk + 4, 3)
  63.                         End If
  64.                    Next ii
  65.               End With
  66.               Kk = Kk + 1
  67.         Next Sld
  68.         With Sht
  69.              .Activate
  70.              .Cells.Font.Size = 9
  71.              .Range("C:J").Select
  72.              Selection.ColumnWidth = 50
  73.              .Range("A:J").EntireColumn.AutoFit
  74.              .Range("A:A,C:C").Select
  75.              'Application.CutCopyMode = False
  76.              Selection.NumberFormatLocal = "G/通用格式"
  77.              Selection.NumberFormatLocal = "yyyy/mm/dd hh:mm:ss"
  78.         End With
  79. End Sub

  80. Function RetuPpt() As PowerPoint.Presentation
  81.    
  82.     Dim Dict As New Scripting.Dictionary
  83.         Set Dict = New Scripting.Dictionary
  84.     Dim Ppt As PowerPoint.Application, Shp, Slds 'As Slides
  85.     Dim Pres As Presentation
  86.          Set Ppt = New PowerPoint.Application
  87.          Ppt.Visible = msoTrue
  88.         '''
  89.          For Each Pres In Ppt.Presentations
  90.                   Set Dict(Pres.Name) = Pres
  91.          Next Pres
  92.          Set RetuPpt = Dict.Items(0)
  93. End Function



  94. '''
  95. Function OpenPpt(Fso As FileSystemObject, PptName) As Presentation
  96.    
  97.    
  98.     Dim Ppt As PowerPoint.Application, Shp, Slds 'As Slides
  99.     Dim Pres As Presentation
  100.          Set Ppt = New PowerPoint.Application
  101.          Ppt.Visible = msoTrue
  102.          If Fso.FileExists(PptName) = False Then
  103.              Set Pres = Ppt.Presentations.Add
  104.              Pres.Application.Visible = msoTrue
  105.              'Pres.SaveAs PptName
  106.              Set OpenPpt = Pres

  107.            Exit Function
  108.          End If
  109.         
  110.         
  111.          For Each Pres In Ppt.Presentations
  112.              If Pres.FullName = PptName Then
  113.                   Set OpenPpt = Pres
  114.                   Exit Function
  115.              End If
  116.          Next Pres
  117.          Set OpenPpt = Ppt.Presentations.Open(PptName, msoFalse)
  118.          Debug.Print OpenPpt.Name, OpenPpt.Path
  119.          Set OpenPpt = Pres
  120. End Function



  121. Function JpgDateToDict(oFiles As Files, Dict As Scripting.Dictionary) As Scripting.Dictionary


  122.      Dim oFile As File
  123.          Kk = 1
  124.          For Each oFile In oFiles
  125.               With oFile
  126.                   '''
  127.                   If InStr(UCase(.Type), "JP") > 0 Then
  128.                       Set Dict(oFile.DateLastModified) = oFile
  129.                   End If
  130.               End With
  131.          Next oFile
  132.          Set JpgDateToDict = Dict
  133. End Function
  134. ''
  135. Function JpgFilesToDict(oFiles As Files, Dict As Scripting.Dictionary) As Scripting.Dictionary


  136.      Dim oFile As File
  137.          Kk = 1
  138.          For Each oFile In oFiles
  139.               With oFile
  140.                   '''
  141.                   If InStr(UCase(.Type), "JP") > 0 Then
  142.                       Set Dict(oFile.Path) = oFile
  143.                   End If
  144.               End With
  145.          Next oFile
  146.          Set JpgFilesToDict = Dict
  147. End Function
  148. '''
  149. Sub JpgDateDictToArr()
  150.     Dim oRow
  151.         oRow = 8
  152.     Dim Sht As Worksheet
  153.         Set Sht = Sheets("FileDate")
  154.         With Sht
  155.              .Activate
  156.              .Cells.Clear
  157.              .Cells.Font.Size = 9
  158.         End With
  159.    
  160.     Dim Rng As Range, Arr
  161.     Dim PicRng As Range
  162.         Set PicRng = Sheets("PicDate").Cells(10, 2).CurrentRegion
  163.         PicRng(, 1).Resize(, 5).Copy
  164.         Sht.Cells(oRow, 3).PasteSpecial xlPasteAll
  165.         '''
  166.     Dim Dict As Scripting.Dictionary, FileDict As Scripting.Dictionary
  167.         Set Dict = New Scripting.Dictionary
  168.         Set FileDict = New Scripting.Dictionary
  169.     Dim Fso As Scripting.FileSystemObject, oFile As File
  170.         Set Fso = New Scripting.FileSystemObject
  171.     Dim oFolder As Folder
  172.     Dim Fia As FileDialog

  173.     Dim Files As Files
  174.         Set oFolder = Fso.GetFolder(ThisWorkbook.Path)
  175.         Set FileDict = JpgDateToDict(oFolder.Files, FileDict)
  176.         oRow = oRow + 1
  177.         For ii = 2 To PicRng.Rows.Count
  178.              'Debug.Print Dict.Keys(ii), Dict.Items(ii).Name
  179.              Set Dict = DictDateCopyPaste(Dict, FileDict, PicRng(ii, 1))
  180.         Next ii
  181.         
  182.         For ii = 0 To Dict.Count - 1
  183.             Arr = Dict.Items(ii)
  184.             Set oFile = Arr(0)
  185.             Set Rng = Arr(1)
  186.             Rng(, 1).Resize(, 8).Copy
  187.             
  188.             With Sht
  189.                  .Cells(oRow + ii, 1) = oFile.Name
  190.                  .Cells(oRow + ii, 2) = oFile.DateLastModified
  191.                  .Cells(oRow + ii, 3).PasteSpecial xlPasteAll
  192.                  .Cells.Font.Size = 9
  193.             End With
  194.         Next ii
  195.    Dim Pres As Presentation
  196.         Set Pres = OpenPpt(Fso, Filename)
  197.         FileDictToPpt Pres, Dict
  198. End Sub
  199. ''
  200. ''</font>
复制代码

TA的精华主题

TA的得分主题

发表于 2025-1-26 00:45 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
ning84 发表于 2025-1-25 07:59
学习RegEx.Pattern = "时间:(.*?)\n地点:(.*?)\n天气:(.*?)\n路段:.*?\n概述:(.*?)\n照片描述:(.*?)$ ...

如果源字符串是多行字符,那么,使用正则表达式的多行属性,可以让正则更加简单。此外,每个事项分别用一个正则表达式,则源字符串中各项无固定顺序,也可以正常提取。

  1. Sub SeparateInfoWithRegex()
  2. '    Dim Slds As Slides
  3. '    Set Slds = Application.ActivePresentation.Slides
  4.     Dim allText As String
  5.     allText = Sheet1.Range("A1").Value
  6. '    allText =Slds(1).NotesPage.Shapes(1).TextFrame.TextRange.Text
  7.     Dim Patt(4) As String
  8.     Patt(0) = "时间"
  9.     Patt(1) = "天气"
  10.     Patt(2) = "地点"
  11.     Patt(3) = "概述"
  12.     Patt(4) = "照片描述"
  13.     Dim RegEx As Object
  14.     Set RegEx = CreateObject("VBScript.RegExp")
  15.     With RegEx
  16.         .Global = True
  17.         .MultiLine = True
  18.         On Error Resume Next
  19.         For i = 0 To 4
  20.             .Pattern = "^" & Patt(i) & ".+"
  21.             Debug.Print .Execute(allText)(0)
  22.         Next
  23.     End With
  24. End Sub
复制代码

image.jpg

评分

1

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2025-1-26 09:00 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
ggmmlol 发表于 2025-1-26 00:45
如果源字符串是多行字符,那么,使用正则表达式的多行属性,可以让正则更加简单。此外,每个事项分别用一 ...

谢谢你的帮助。

深入学习,正则表达式的多行属性的基本知识。

在 VBA(Visual Basic for Applications)中使用正则表达式时,可以通过设置相应的属性来启用多行模式。多行模式允许 `^` 和 `$` 锚点匹配每一行的开头和结尾,而不仅仅是整个字符串的开头和结尾。这对于处理包含多行的文本数据非常有用。

以下是如何在 VBA 中使用正则表达式的多行属性的详细说明和示例。

## 步骤一:引用 Microsoft VBScript Regular Expressions 库

首先,需要在 VBA 编辑器中引用 **Microsoft VBScript Regular Expressions** 库。这将允许你使用 `RegExp` 对象及其相关功能。

1. 打开 Excel(或其他 Office 应用程序)。
2. 按下 `ALT + F11` 打开 VBA 编辑器。
3. 在菜单栏中选择 **工具(Tools)** > **引用(References)**。
4. 在弹出的对话框中,找到并勾选 **Microsoft VBScript Regular Expressions 5.5**(或更高版本,如果可用)。
5. 点击 **确定** 关闭对话框。

## 步骤二:创建和使用 RegExp 对象

以下是一个示例,展示如何在 VBA 中使用正则表达式的多行属性来匹配每一行的开头。

### 示例场景

假设有以下多行文本存储在单元格 `A1` 中:

```
Hello World
foo line1
foo line2
Goodbye World
```

**目标**:匹配所有以 `foo` 开头的行。

### VBA 代码示例

```vba
Sub RegexMultilineExample()
    Dim regEx As Object
    Dim inputText As String
    Dim matches As Object
    Dim match As Object
    Dim result As String
   
    ' 获取输入文本(例如,从单元格 A1)
    inputText = ThisWorkbook.Sheets(1).Range("A1").Value
   
    ' 创建 RegExp 对象
    Set regEx = CreateObject("VBScript.RegExp")
   
    With regEx
        .Global = True ' 查找所有匹配项
        .MultiLine = True ' 启用多行模式
        .IgnoreCase = True ' 忽略大小写(可选)
        
        ' 设置正则表达式模式,^ 匹配每一行的开头
        .Pattern = "^foo.*"
        
        ' 执行匹配
        Set matches = .Execute(inputText)
    End With
   
    ' 处理匹配结果
    result = ""
    For Each match In matches
        result = result & match.Value & vbCrLf
    Next match
   
    ' 显示结果(例如,在消息框中)
    MsgBox result, vbInformation, "匹配结果"
   
    ' 清理对象
    Set regEx = Nothing
End Sub
```

### 代码解释

1. **引用文本**:从单元格 `A1` 获取多行文本。
2. **创建 RegExp 对象**:使用 `CreateObject("VBScript.RegExp")` 创建一个正则表达式对象。
3. **设置属性**:
    - `.Global = True`:查找所有匹配项,而不仅仅是第一个。
    - `.MultiLine = True`:启用多行模式,使 `^` 和 `$` 匹配每一行的开头和结尾。
    - `.IgnoreCase = True`:忽略大小写(可根据需要选择是否启用)。
    - `.Pattern = "^foo.*"`:设置正则表达式模式,匹配以 `foo` 开头的整行。
4. **执行匹配**:使用 `.Execute` 方法在输入文本中查找所有匹配项。
5. **处理结果**:遍历所有匹配项,并将它们拼接成一个字符串以供显示。
6. **显示结果**:使用 `MsgBox` 显示匹配结果。
7. **清理对象**:释放 `RegExp` 对象占用的资源。

### 运行结果

执行上述代码后,将弹出一个消息框,显示以下内容:

```
foo line1
foo line2
```

这表明正则表达式成功匹配了所有以 `foo` 开头的行。

## 其他多行匹配示例

### 匹配每一行的结尾

如果你想匹配所有以 "World" 结尾的行,可以修改正则表达式模式如下:

```vba
.RegExp.Pattern = ".*World$"
```

### 示例文本

```
Hello World
foo World
Goodbye World
```

**匹配结果**:

```
Hello World
foo World
Goodbye World
```

### 匹配特定模式的行

例如,匹配所有包含数字的行:

```vba
.RegExp.Pattern = ".*\d+.*"
```

### 示例文本

```
Hello World
foo123 line
bar line456
Goodbye World
```

**匹配结果**:

```
foo123 line
bar line456
```

## 注意事项

1. **确保启用多行模式**:在使用 `^` 和 `$` 锚点匹配每一行的开头和结尾时,必须将 `.MultiLine` 属性设置为 `True`。
2. **性能考虑**:对于非常大的文本,复杂的正则表达式可能会影响性能。优化正则表达式以提高效率。
3. **转义特殊字符**:如果你的模式中包含正则表达式的特殊字符(如 `.`, `*`, `?` 等),需要使用反斜杠 `\` 进行转义,例如 `\.` 匹配字面上的句号。
4. **错误处理**:在实际应用中,建议添加错误处理机制,以应对可能的异常情况,如无效的正则表达式模式。

通过以上方法,你可以在 VBA 中有效地使用正则表达式的多行属性,处理和分析多行文本数据。
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

1234

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2025-2-13 15:13 , Processed in 0.035749 second(s), 17 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表