Far funzionare i caratteri jolly nella funzione Trova e sostituisci nella macro VBA per Microsoft Word
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
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.