饿郎每天都在为肚子奔波

关键词词频修正表达式，试了下，非常有用，特转过来。

'正则表达式函数
Function doReExec(strng,patrn)
  Dim regEx, Match, Matches,RetStr      ' 创建变量。
  Set regEx = New RegExp         ' 创建正则表达式。
  regEx.Pattern = patrn          ' 设置模式。
  regEx.IgnoreCase = True         ' 设置为不区分大小写。
  regEx.Global = True         ' 设置全局适用。
  Set Matches = regEx.Execute(strng)   ' 执行搜索。
  For Each Match in Matches      ' 对 Matches 集合进行迭代。
    RetStr = RetStr & Match.Value & "," & vbCRLF
  Next
  doReExec = RetStr
End Function

'词频修正函数
Function Original(str)
        
        Dim temparr,ltemp,ltemp2
        str = Replace(str,vbCrLf,"")
        
        temparr = ""
        If Trim(temparr) = "" Then temparr = doReExec(str,"<p[^>]*>([^<]+)</p>")
        If Trim(temparr) = "" Then temparr = doReExec(str,"<br>([^<]+)<br>")
        If Trim(temparr) = "" Then temparr = doReExec(str,"<div [^>]*>([^<]+)</div>")
        If Trim(temparr) = "" Then temparr = doReExec(str,"<span [^>]*>([^<]+)</span>")
        If Trim(temparr) = "" Then Original = str : Exit Function

        temparr = Split(temparr,",")
        randomize
        ltemp = Int(Rnd()*UBound(temparr))+1
        ltemp2 = Timer Mod UBound(temparr)
        Original = "<div id=""correct""><b>本文摘要</b>:<br />" & temparr(ltemp) &  temparr(ltemp2) &  "</div>" & str
End Function