Microsoft Word 용 VBA 매크로에서 찾기 및 교체 기능에서 작업 할 와일드 카드

StackOverflow https://stackoverflow.com/questions/1438684

  •  08-07-2019
  •  | 
  •  

문제

개선하려는 Microsoft Word 용 VBA 매크로가 있습니다.

매크로의 목적은 문서의 첫 번째 표에서 검색어와 일치하는 문서에서 모든 단어를 굵게 표시하고 이탤릭체화하는 것입니다.

문제는 검색어에 다음과 같은 와일드 카드가 포함된다는 것입니다.

하이픈 "-": 공간이나 기간에 대한 와일드 카드 문자 사이

Asterisk "&": (이 사이트는이 기울임에 대한 마크 다운이므로 별표를 넣을 수 없으므로 필터를 주위에 가져 오기 위해 & 기호에 넣을 것입니다). 단어 또는 끝에. 그러나 일반적인 프로그래밍 언어와 달리 단어 중간에 사용되면 다양한 문자의 와일드 카드가 되려면 하이픈과 결합해야합니다. 예를 들어 "th & -e"는 "거기"를 픽업하는 반면 "th & e"는 그렇지 않을 것입니다.

물음표 "?": 단일 캐릭터의 와일드 카드

내가 지금까지하고있는 것은이 캐릭터들을 테스트하는 것입니다. 그들이 존재하는 경우 별표의 경우에 그들을 꺼내거나, 사용자에게 단어를 수동으로 검색해야한다는 것을 알립니다. 이상적이지 않습니다 : -P

VBA에서 .matchwildcard 속성을 시도했지만 아직 작동하지 않았습니다. 검색 텍스트가 아니라 교체 텍스트와 관련이 있다고 생각합니다.

작동하는 매크로는 입력으로 다음을 취합니다 (첫 번째 행은 의도적으로 무시되고 두 번째 열은 대상 검색어가있는 것입니다).

두 번째 열에있는 테이블에서 이것을 상상해보십시오 (여기에서 허용 된 HTML이 TR 및 TD 등을 허용하지 않기 때문에).

첫 번째 줄 : 단어
두 번째 줄 : 검색
세 번째 줄 : & Earch1
네 번째 줄 : search2 &
다섯 번째 줄 : s-search3
여섯 번째 줄 : S? Arch4
일곱 번째 행 : S & -CH5

그리고 문서를 검색하고 다음과 같은 대담하고 이탤릭체 화 된 컨텐츠로 대체합니다.

Search1 Search2 Search3 Search4 Search5

참고 : s-search3는 S.earch3를 픽업하고 Search3로 교체 할 수 있습니다.

검색어가 일반적으로 서로 옆에 있지 않다고 가정 할 수 있듯이 매크로는 모든 인스턴스를 찾아야합니다.

첫 번째 작업 매크로 후에도 시도했지만 작동하지 않는 코드도 포함 할 것입니다.

작동하는 매크로 코드는 오늘부터 한 달 동안 페이스트 빈 (Pastebin)에 있습니다. URL.

모든 생각에 다시 한 번 감사 드리고 제공해야 할 수도 있습니다!

사라

작업 VBA 매크로 :

Sub AllBold()

Dim tblOne As Table

Dim celTable As Cell

Dim rngTable As Range

Dim intCount As Integer

Dim celColl As Cells

Dim i As Integer

Dim rngLen As Integer

Dim bolWild As Boolean

Dim strWild As String


Set tblOne = ActiveDocument.Tables(1)

intCount = tblOne.Columns(2).Cells.Count

Set celColl = tblOne.Columns(2).Cells

strWild = ""

For i = 1 To intCount

    If i = 1 Then

    i = i + 1

    End If

    Set celTable = ActiveDocument.Tables(1).Cell(Row:=i, Column:=2)

    Set rngTable = ActiveDocument.Range(Start:=celTable.Range.Start, _
        End:=celTable.Range.End - 1)

    rngLen = Len(rngTable.Text)

    bolWild = False

    If (Mid(rngTable.Text, rngLen, 1) = "&") Then 'remember to replace & with asterisk!'

    rngTable.SetRange Start:=rngTable.Start, End:=rngTable.End - 1

    End If

    If (Mid(rngTable.Text, 1, 1) = "&") Then 'remember to replace & with asterisk!'

    rngTable.SetRange Start:=rngTable.Start + 1, End:=rngTable.End

    End If

    If InStr(1, rngTable.Text, "-", vbTextCompare) > 0 Then

    strWild = strWild + rngTable.Text + Chr$(13)

    bolWild = True

    End If

    If InStr(1, rngTable.Text, "?", vbTextCompare) > 0 Then

    strWild = strWild + rngTable.Text + Chr$(13)

    bolWild = True

    End If

    If (bolWild = False) Then

        Dim oRng As Word.Range

            Set oRng = ActiveDocument.Range

            With oRng.Find

            .ClearFormatting

            .Text = rngTable.Text

            With .Replacement

            .Text = rngTable.Text

            .Font.Bold = True

            .Font.Italic = True

            End With

            .Execute Replace:=wdReplaceAll

    End With

    End If

Next

If bolWild = True Then

MsgBox ("Please search the following strings with - or ? manually:" + Chr$(13) + strWild)

End If

End Sub

비 기능적 VBA 매크로 시도 :

Sub AllBoldWildcard()

Dim tblOne As Table

Dim celTable As Cell

Dim rngTable As Range

Dim intCount As Integer

Dim celColl As Cells

Dim i As Integer

Dim rngLen As Integer

Dim bolWild As Boolean

Dim strWild As String

Dim strWildcard As String


Set tblOne = ActiveDocument.Tables(1)

intCount = tblOne.Columns(2).Cells.Count

Set celColl = tblOne.Columns(2).Cells

strWild = ""

For i = 1 To intCount

    If i = 1 Then

    i = i + 1

    End If

    Set celTable = ActiveDocument.Tables(1).Cell(Row:=i, Column:=2)

    Set rngTable = ActiveDocument.Range(Start:=celTable.Range.Start, _
        End:=celTable.Range.End - 1)

    rngLen = Len(rngTable.Text)

    bolWild = False

    If (Mid(rngTable.Text, 1, 1) = "&") Then 'remember to replace & with asterisk!'

    rngTable.SetRange Start:=rngTable.Start + 1, End:=rngTable.End

    End If

    If InStr(1, rngTable.Text, "&", vbTextCompare) > 0 Then 'remember to replace & with asterisk!'

    strWildcard = rngTable.Text

    rngTable.Text = Replace(rngTable.Text, "&", "", 1) 'remember to replace & with asterisk!'

    bolWild = True

    End If

    If InStr(1, rngTable.Text, "-", vbTextCompare) > 0 Then

    strWildcard = Replace(rngTable.Text, "-", "[.-]", 1)

    bolWild = True

    End If

    If InStr(1, rngTable.Text, "?", vbTextCompare) > 0 Then

    strWild = strWild + rngTable.Text + Chr$(13)

    strWildcard = Replace(rngTable.Text, "?", "_", 1)


    bolWild = True

    End If

    If (bolWild = False) Then

        Dim oRng As Word.Range

            Set oRng = ActiveDocument.Range

            With oRng.Find

            .ClearFormatting

            .Text = strWildcard

            .MatchAllWordForms = False

            .MatchSoundsLike = False

            .MatchFuzzy = False

            .MatchWildcards = True


            With .Replacement

            .Text = rngTable.Text

            .Font.Bold = True

            .Font.Italic = True

            End With

            .Execute Replace:=wdReplaceAll

    End With

    End If

Next

'    If bolWild = True Then'

'    MsgBox ("Please search the following strings with - or ? manually:" + Chr$(13) + strWild)'

'    End If'

End Sub
도움이 되었습니까?

해결책 2 

Sub AllBold()

Dim tblOne As Table
Dim celTable As Cell
Dim rngTable As Range
Dim intCount As Integer
Dim intMatch As Integer
Dim celColl As Cells
Dim i As Integer
Dim strRegex As String
Dim Match, Matches

Set tblOne = ActiveDocument.Tables(1)
intCount = tblOne.Columns(2).Cells.Count
Set celColl = tblOne.Columns(2).Cells
Set objRegEx = CreateObject("vbscript.regexp")
objRegEx.Global = True
objRegEx.IgnoreCase = True
objRegEx.MultiLine = True

For i = 1 To intCount
    If i = 1 Then
        i = i + 1
    End If

    Set celTable = ActiveDocument.Tables(1).Cell(Row:=i, Column:=2)
    Set rngTable = ActiveDocument.Range(Start:=celTable.Range.Start, _
                                        End:=celTable.Range.End - 1)

    If rngTable.Text <> "" Then
        strRegex = rngTable.Text
        strRegex = Replace(strRegex, "*-", "[\w]{0,}[^\w]{0,1}[\w]{0,}", 1)
        strRegex = Replace(strRegex, "*", "\w+", 1)
        strRegex = Replace(strRegex, "-", "[^\w]{0,1}", 1)
        strRegex = Replace(strRegex, "?", ".", 1)
        objRegEx.Pattern = "\b" + strRegex + "\b"

        Dim oRng As Word.Range
        Set oRng = ActiveDocument.Range
        Set Matches = objRegEx.Execute(ActiveDocument.Range.Text)

        intMatch = Matches.Count
        If intMatch >= 1 Then
            rngTable.Bold = True
            For Each Match In Matches
                With oRng.Find
                    .ClearFormatting
                    .Text = Match.Value
                    With .Replacement
                        .Text = Match.Value
                        .Font.Bold = True
                        .Font.Italic = True
                    End With

                    .Execute Replace:=wdReplaceAll
                End With
            Next Match
        End If
    End If
Next i

End Sub

다른 팁

어쩌면 같은 진술이 도움이 될 수 있습니다.

if "My House" like "* House" then

end if

정규 표현식 : Search4 검색 및 Search4로 교체하고 와일드 카드를 사용하여이를 달성합니다.

Set objRegEx = CreateObject("vbscript.regexp")
objRegEx.Global = True
objRegEx.IgnoreCase = True
objRegEx.MultiLine = True 

'here you can enter your search with wild cards
'mine says "S" followed by any character followed by "arch" followed by 1-n numbers.
objRegEx.Pattern = "S.arch([0-9]+)"


newText = objRegEx.Replace("Test Search4", "SEARCH$1")
MsgBox (newText) 
'gives you: Test SEARCH4

더 많은 정보를 사용할 수있는 방법을 찾을 수 있습니다. 여기처음에는 어려울 수 있지만 나는 당신이 그것을 사랑할 것이라고 약속합니다.)

문자열을 검색하기 위해 사용을 교체 할 수도 있습니다.

DIM 텍스트 문자열 text = "Hello Search4 Search3 Saarch2 Search0 Search"

Set objRegEx = CreateObject("vbscript.regexp")
objRegEx.Global = True
objRegEx.IgnoreCase = True
objRegEx.MultiLine = True

'here you can enter your search with wild cards
'mine says "S" followed by any character followed by "arch" followed by 1-n numbers.
objRegEx.Pattern = "S.arch[0-9]+"


If (objRegEx.test(text) = True) Then
    Dim objMatch As Variant
    Set objMatch = objRegEx.Execute(text)   ' Execute search.

    Dim wordStart As Long
    Dim wordEnd As Long
    Dim intIndex As Integer
    For intIndex = 0 To objMatch.Count - 1
        wordStart = objMatch(intIndex).FirstIndex
        wordEnd = wordStart + Len(objMatch(intIndex))

        MsgBox ("found " & objMatch(intIndex) & " position: " & wordStart & " - " & wordEnd)
    Next
End If

변수 텍스트의 결과는 다음과 같습니다.

Search4 position: 6 - 13
Search3 position: 14- 21
...

따라서 코드에서 사용할 수 있습니다

rngTable.Text as text

그리고 

rngTable.SetRange Start:=rngTable.Start + wordStart, End:=rngTable.Start + wordEnd

대담한 범위 일 것입니다.

라이센스 : CC-BY-SA ~와 함께 속성
제휴하지 않습니다 StackOverflow
scroll top