Far funzionare i caratteri jolly nella funzione Trova e sostituisci nella macro VBA per Microsoft Word

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

  •  08-07-2019
  •  | 
  •  

Domanda

Ho una macro VBA per Microsoft Word che sto cercando di migliorare.

Lo scopo della macro è di mettere in grassetto e in corsivo tutte le parole di un documento che corrispondono ai termini di ricerca nella prima tabella del documento.

Il problema è che i termini di ricerca includono caratteri jolly che sono i seguenti:

il trattino " - " ;: tra le lettere un carattere jolly per uno spazio o un punto

asterisco " & amp; " ;: (il sito non mi consente di inserire asterischi poiché questo è il markdown per il corsivo, quindi inserirò il simbolo & amp; invece di aggirare i filtri) un carattere jolly per qualsiasi numero di caratteri all'inizio di una parola o alla fine. A differenza dei normali linguaggi di programmazione, tuttavia, quando viene utilizzato nel mezzo della parola, deve essere combinato con il trattino per essere un carattere jolly per un intervallo di caratteri. Ad esempio " th & amp; -e " raccoglierebbe "lì" mentre " th & amp; e " no.

punto interrogativo "? " ;: carattere jolly per un singolo carattere

Quello che sto facendo finora è solo testare questi personaggi e, se sono presenti, li scarto nel caso dell'asterisco o avviso l'utente che devono cercare la parola manualmente. Non ideale :-P

Ho provato la proprietà .MatchWildcard in VBA ma non l'ho ancora fatta funzionare. Ho la sensazione che abbia qualcosa a che fare con il testo di sostituzione, non con il testo di ricerca.

Una macro funzionante prenderà quanto segue come input (la prima riga viene intenzionalmente ignorata e la seconda colonna è quella con i termini di ricerca target):

Immagina questo in una tabella tutta nella seconda colonna (poiché il codice HTML consentito qui non consente tr e td ecc)

  

Prima riga: Word
  Seconda fila: cerca
  Terza riga: & amp; earch1
  Quarta riga: Search2 & amp;
  Quinta fila: S-earch3
  Sesta fila: S? Arch4
  Settima fila: S & amp; -ch5

E cercherà il documento e lo sostituirà con contenuti in grassetto e in corsivo in questo modo:

Cerca Cerca1 Cerca2 Cerca3 Cerca4 Cerca5

Nota: S-earch3 potrebbe anche prendere S.earch3 e sostituirlo con Search3

Come si potrebbe supporre, i termini di ricerca di solito non si trovano uno accanto all'altro: la macro dovrebbe trovare tutte le istanze.

Includerò anche il mio codice tentato ma non funzionale dopo la prima macro funzionante.

Il codice per la macro di lavoro sarà su pastebin per un mese da oggi, ovvero il 17/09/09, al seguente URL .

Grazie ancora per ogni pensiero e aiuto che potresti avere da offrire!

Sara

Macro VBA funzionante:

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

Tentativo di macro VBA non funzionale:

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
È stato utile?

Soluzione 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

Altri suggerimenti

Forse l'istruzione LIKE potrebbe aiutarti:

if "My House" like "* House" then

end if

Espressioni regolari: Cercare Search4 e sostituirlo con SEARCH4 e utilizzare i caratteri jolly per raggiungere questo obiettivo:

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

Ulteriori informazioni su come utilizzare i caratteri jolly da utilizzare qui Potrebbe essere difficile all'inizio, ma prometto che lo adorerai;)

Puoi sostituire use anche per cercare stringhe:

Dim text As String 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

Il risultato per il testo variabile sarebbe:

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

Quindi nel tuo codice useresti

rngTable.Text as text

e

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

sarebbe l'intervallo che si desidera impostare in grassetto.

Autorizzato sotto: CC-BY-SA insieme a attribuzione
Non affiliato a StackOverflow
scroll top