写入字典出错：将文档中以数字开头的文段依次录入字典

weiyingde

Sub 将文档中以数字开头的文段依次录入字典()
Dim d , arr(), brr(), m

Set sr = ActiveDocument.Content
Set d = CreateObject("scripting.dictionary")
With CreateObject("vbscript.regexp")
     .Global = True
     .IgnoreCase = False
     .MultiLine = True
     .Pattern = "^[\xa0\u3000\s]*(\d+)[^\r]+"
        For Each m In .Execute(sr)
      '   n = n + 1
      '   ReDim Preserve arr(1 To n)
      '   ReDim Preserve brr(1 To n)
      '   arr(n) = m.Value
      '   brr(n) = m.SubMatches(0)
         d(m.SubMatches(0)) = m.Value
        '  d(brr(n)) = arr(n)
         ' d.Add brr(n), arr(n)
        Next
          k = d.keys
          t = d.Items
        For i = 1 To k.Count
          MsgBox k(i) & "   " & t(i)
        Next
End With
End Sub

weiyingde

自我解决问题，代码如下，以备后查。
Sub 将文档中以数字开头的文段依次录入字典()
Dim d, m, arr(), brr()
Set sr = ActiveDocument.Content
Set d = CreateObject("scripting.dictionary")
With CreateObject("vbscript.regexp")
     .Global = True
     .IgnoreCase = False
     .MultiLine = True
     .Pattern = "^[\xa0\u3000\s]*(\d+)[^\r]+"
        For Each m In .Execute(sr)
         n = n + 1
         ReDim Preserve arr(1 To n)
         ReDim Preserve brr(1 To n)
         arr(n) = m.Value
         brr(n) = m.SubMatches(0)
          d(brr(n)) = arr(n)
         Next
          k = d.keys
          t = d.Items
        For i = 1 To UBound(k)
           MsgBox k(i) & "   " & t(i)
         Next
End With
End Sub

weiyingde

精简一下，代码如下：
Sub 将文档中以数字开头的文段依次录入字典()
Dim d, m
Set sr = ActiveDocument.Content
Set d = CreateObject("scripting.dictionary")
With CreateObject("vbscript.regexp")
     .Global = True
     .IgnoreCase = False
     .MultiLine = True
     .Pattern = "^[\xa0\u3000\s]*(\d+)[^\r]+"
        For Each m In .Execute(sr)
                d(m.SubMatches(0)) = m.Value‘为数值型
         set  d(m.SubMatches(0))  =activedocument.range(m.firstindex,m.firstindex+m.lenth) '为range
         Next
          k = d.keys
          t = d.Items
        For i = 1 To UBound(k)
           MsgBox k(i) & "   " & t(i)
         Next
End With
End Sub