HTML, 단어, 숫자 및 날짜가 혼합 된 문자열 구문 분석

Question

문자열에서 고유 한 단어와 숫자 값을 추출해야합니다. 이 시점에서 모든 것을 제거하고 영숫자 단어 만 반환하는 함수가 있습니다. 또한 단어가 실제로 날짜 또는 숫자인지 인식하고 텍스트가 분리되지 않도록해야합니다. 어떻게해야합니까?

GetAlphaNumericWords("Hello World! Test 1. 123.45 8/22/2013 August 22, 2013") 

Hello 
World 
Test 
1 
123 
45 
8 
22 
2013 
August 

내가 정말 원하는 것은 :

Hello 
World 
Test 
1 
123.45 
8/22/2013 

Answer 1

Public Function GetAlphaNumericWords(ByVal InputText As String) As Collection 
' This function splits the rich text input into unique alpha-numeric only strings 
    Dim words() As String 
    Dim characters() As Byte 
    Dim text As Variant 
    Dim i As Long 

    Set GetAlphaNumericWords = New Collection 

    text = Trim(PlainText(InputText)) 
    If Len(text) > 0 Then 
    ' Replace any non alphanumeric characters with a space 
     characters = StrConv(text, vbFromUnicode) 
     For i = LBound(characters) To UBound(characters) 
      If Not (Chr(characters(i)) Like "[A-Za-z0-9 ]") Then 
       characters(i) = 32 ' Space character 
      End If 
     Next 
     ' Merge the byte array back to a string and then split on spaces 
     words = VBA.Split(StrConv(characters, vbUnicode)) 

     ' Add each unique word to the output collection 
     On Error Resume Next 
     For Each text In words 
      If (text <> vbNullString) Then GetAlphaNumericWords.Add CStr(text), CStr(text) 
      If Err Then Err.Clear 
     Next 
    End If 
End Function 

이 기능은 현재 반환 출력의 예 : 여기

내가 현재 가지고있는 분할 기능입니다 이것은 정규 표현식을 사용할 수있을 때 많은 작업처럼 보입니다. 좋은 출발점은 here 및 here을 참조하십시오. 당신이 참조에 "마이크로 소프트 VBScript 정규 표현식 5.5"를 추가하고 다음과 같은 기능을 추가하는 경우

(나는 경우에 그들은 다른 곳에 유용하다, 필요 이상으로 몇 가지 더 많은 기능을 포함 시켰습니다) :

Public Function RegEx(strInput As String, strRegEx As String, Optional bIgnoreCase As Boolean = True, Optional bMultiLine As Boolean = False) As Boolean 
    Dim RegExp As VBScript_RegExp_55.RegExp 
    Set RegExp = New VBScript_RegExp_55.RegExp 
    With RegExp 
     .MultiLine = bMultiLine 
     .IgnoreCase = bIgnoreCase 
     .Pattern = strRegEx 
    End With 
    RegEx = RegExp.test(strInput) 
    Set RegExp = Nothing 
End Function 

Public Function RegExMatch(strInput As String, strRegEx As String, Optional MatchNo As Long = 0, Optional FirstIDX As Long, Optional Lgth As Long, Optional bIgnoreCase As Boolean = True, Optional bMultiLine As Boolean = False) As String 
    Dim RegExp As VBScript_RegExp_55.RegExp, Matches As VBScript_RegExp_55.MatchCollection 
    Set RegExp = New VBScript_RegExp_55.RegExp 
    With RegExp 
     .Global = True 
     .MultiLine = bMultiLine 
     .IgnoreCase = bIgnoreCase 
     .Pattern = strRegEx 
    End With 
    If RegExp.test(strInput) Then 
     Set Matches = RegExp.Execute(strInput) 
     If MatchNo > Matches.Count - 1 Then 
      RegExMatch = "" 
     Else 
      RegExMatch = Matches(MatchNo).value 
      FirstIDX = Matches(MatchNo).FirstIndex 
      Lgth = Matches(MatchNo).Length 
     End If 
    Else 
     RegExMatch = "" 
    End If 
    Set RegExp = Nothing 
End Function 

Public Function RegexMatches(strInput As String, strRegEx As String, Optional bIgnoreCase As Boolean = True, Optional bMultiLine As Boolean = False) As VBScript_RegExp_55.MatchCollection 
    Dim RegExp As VBScript_RegExp_55.RegExp 
    Set RegExp = New VBScript_RegExp_55.RegExp 
    With RegExp 
     .Global = True 
     .MultiLine = bMultiLine 
     .IgnoreCase = bIgnoreCase 
     .Pattern = strRegEx 
    End With 
    Set RegexMatches = RegExp.Execute(strInput) 
    Set RegExp = Nothing 
End Function 

Public Function RegExReplace(strInput As String, strRegEx As String, strReplace As String, Optional bGlobal As Boolean = True, Optional bIgnoreCase As Boolean = True, Optional bMultiLine As Boolean = False) As String 
    Dim RegExp As VBScript_RegExp_55.RegExp 
    Set RegExp = New VBScript_RegExp_55.RegExp 
    With RegExp 
     .MultiLine = bMultiLine 
     .IgnoreCase = bIgnoreCase 
     .Pattern = strRegEx 
     .Global = bGlobal 
    End With 
    RegExReplace = RegExp.Replace(strInput, strReplace) 
    Set RegExp = Nothing 
End Function 

훨씬 더 유용하고 우아한 솔루션을 만들기 위해 그것들을 사용할 수 있어야합니다.

당신은 유사한 정규식 패턴을 고려해야 다음

\b(\w+)\b 

및 다음과 유사한 코드 - RegexMatches를 사용하여 각 경기 & submatch를 들어, CDec과에 CDate을 시도하고 경우 거부를 내가 버퍼 그쪽을 만들 생각했다

Dim Matches As VBScript_RegExp_55.MatchCollection 
... 
Set Matches = RegexMatches(InputText , "\b(\w+)\b") 
       If Matches.Count > 0 Then 
        For CtrA = 0 To Matches.Count - 1 
         For CtrB = 0 To Matches(CtrA).SubMatches.Count - 1 
          On Error Resume Next 
          TestVariant = Null 
          TestVariant = CDec(Matches(CtrA).Submatches(CtrB)) 
          TestVariant = CDate(Matches(CtrA).Submatches(CtrB)) 
          On Error Goto 0 
          If IsNull(TestVariant) Then 
           ' Do further processing to check if the submatch can be split on non-alphanumeric characters... 
          Else 
           GetAlphaNumericWords.Add Matches(CtrA).Submatches(CtrB), Matches(CtrA).Submatches(CtrB) 
          End If 
         Next 
        Next 
       End If