正则表达式，如何提取"件号" + X-XX形式的字符串？

Question

RegEXP.Pattern = "\d+(\s*-\s*\d+)*"
下面代码提取Arr中的字符串结果是
1
1-1
12-23
111-3
2168-4
如何改代码，实现下面的目标需求。
件号1
件号1-1
件号12-23
件号111-3
件号2168-4
************
Sub ll()
  Dim Rng As Range, Str, oStr
  Set Rng = Cells(3, 1).CurrentRegion
  Arr = Array("更改件号1管箱.Dwg的任意尺寸。", "更改件号1-1封头.Dwg的任意尺寸。", "更改件号12-23短节.Dwg的任意尺寸。", "更改件号111-3法兰.Dwg的任意尺寸。", "更改件号2168-4接管.Dwg的任意尺寸。")
  For ii = 0 To UBound(Arr)
    oStr = ss(Arr(ii))
    Debug.Print oStr
  Next ii
End Sub
Function ss(Str)
  Dim I As Long, lngMaxRow As Long
  Dim RegEXP    As Object
  Dim MatCh     As Object
  
  Set RegEXP = CreateObject("VBScript.RegExp")
  RegEXP.Pattern = "\d+(\s*-\s*\d+)*"
  Set MatCh = RegEXP.Execute(Str)
  ss = MatCh(0)
  
End Function

Answer 1

引用了 Microsoft VBScript Regular Expressions 5.5Dim reg As RegExp, Match As Object, i As IntegerSet reg = New RegExp
reg.Global = True
reg.Pattern = "件号\d+(\s*-\s*\d+)*"
Set Match = reg.Execute("更改件号1管箱.Dwg的任意尺寸。" & "更改件号1-1封头.Dwg的任意尺寸。" & "更改件号12-23短节.Dwg的任意尺寸。" & "更改件号111-3法兰.Dwg的任意尺寸。" & "更改件号2168-4接管.Dwg的任意尺寸。") For i = 0 To Match.Count - 1
Debug.Print Match.Item(i)
Next i

Answer 2

谢谢你的代码，正则表达式学了很长时间，就是不能灵活应用。目标需求代码如下Sub aa()
  Dim Arr, Str
  Str = "更改件号1管箱.Dwg的任意尺寸。更改件号1-1封头.Dwg的任意尺寸。更改件号12-23短节.Dwg的任意尺寸。更改件号111-3法兰.Dwg的任意尺寸。更改件号2168-4接管.Dwg的任意尺寸。"
  Debug.Print Str
  Arr = retuPartNumber(Str)
  For ii = 0 To UBound(Arr)
    Debug.Print Arr(ii)
  Next ii
End SubFunction retuPartNumber(Str)
  Dim rArr()
  Dim Reg As Object, Match As Object, i As Integer
  Set Reg = CreateObject("VBScript.RegExp")
  Reg.Global = True
  Reg.Pattern = "件号\d+(\s*-\s*\d+)*"
  Set Match = Reg.Execute(Str)
  nn = Match.Count - 1
  ReDim rArr(nn)
  For i = 0 To nn
    rArr(i) = Match.Item(i)
  Next i
  retuPartNumber = rArr
End Function