VBAでWordの検索語を強調表示

Question

検索されたすべての単語を強調表示するコードが必要です。この種の作品はすでにコードがありますが、30行目以降はすべてを強調表示します。わかりやすくするために写真を追加します。私は自分のコードで何が間違っているのか、何が解決できるのか分かりません。

は、ここに私のコードです。

Sub Highlight() 
Application.ScreenUpdating = False 
Dim Rng As Range 
Dim cFnd As String 
Dim xTmp As String 
Dim x As Long 
Dim m As Long 
Dim y As Long 
cFnd = ComboBox1.Value 
y = Len(cFnd) 
For Each Rng In Selection 
    With Rng 
    m = UBound(Split(Rng.Value, cFnd)) 
    If m > 0 Then 
     xTmp = "" 
     For x = 0 To m - 1 
     xTmp = xTmp & Split(Rng.Value, cFnd)(x) 
     .Characters(Start:=Len(xTmp) + 1, Length:=y).Font.ColorIndex = 3 
     xTmp = xTmp & cFnd 
     Next 
    End If 
    End With 
Next Rng 
Application.ScreenUpdating = True 
End Sub 

これは、写真に示すページに検索結果をもたらすために、検索コードです。

Sub FindOne() 

Range("B19:J5000") = "" 

Application.ScreenUpdating = False 

Dim k As Integer, EndPasteLoopa As Integer, searchColumn As Integer, searchAllCount As Integer 
Dim myText As String 
Dim totalValues As Long 
Dim nextCell As Range 
Dim searchAllCheck As Boolean 

k = ThisWorkbook.Worksheets.Count 
myText = ComboBox1.Value 
Set nextCell = Range("B20") 
If myText = "" Then 
    MsgBox "No Address Found" 
    Exit Sub 
End If 

Select Case ComboBox2.Value 
    Case "SEARCH ALL" 
     searchAllCheck = True 
    Case "EQUIPMENT NUMBER" 
     searchColumn = 1 
    Case "EQUIPMENT DESCRIPTION" 
     searchColumn = 3 
    Case "DUPONT NUMBER" 
     searchColumn = 6 
    Case "SAP NUMBER" 
     searchColumn = 7 
    Case "SSI NUMBER" 
     searchColumn = 8 
    Case "PART DESCRIPTION" 
     searchColumn = 9 
    Case "" 
     MsgBox "Please select a value for what you are searching by." 
End Select 

For I = 2 To k 
    totalValues = Sheets(I).Cells(Rows.Count, "A").End(xlUp).Row 
    ReDim AddressArray(totalValues) As String 

    If searchAllCheck Then 
     searchAllCount = 5 
     searchColumn = 1 
    Else 
     searchAllCount = 0 
    End If 

    For qwerty = 0 To searchAllCount 
     If searchAllCount Then 
      Select Case qwerty 
       Case "1" 
        searchColumn = 3 
       Case "2" 
        searchColumn = 6 
       Case "3" 
        searchColumn = 7 
       Case "4" 
        searchColumn = 8 
       Case "5" 
        searchColumn = 9 
      End Select 
     End If 

     For j = 0 To totalValues 
      AddressArray(j) = Sheets(I).Cells(j + 1, searchColumn).Value 
     Next j 

      For j = 0 To totalValues 
      If InStr(1, AddressArray(j), myText) > 0 Then 
       EndPasteLoop = 1 
       If (Sheets(I).Cells(j + 2, searchColumn).Value = "") Then EndPasteLoop = Sheets(I).Cells(j + 1, searchColumn).End(xlDown).Row - j - 1 
       For r = 1 To EndPasteLoop 
        Range(nextCell, nextCell.Offset(0, 8)).Value = Sheets(I).Range("A" & j + r, "I" & j + r).Value 
        Set nextCell = nextCell.Offset(1, 0) 
       Next r 
      End If 
     Next j 
    Next qwerty 
Next 
Application.ScreenUpdating = True 
Range("A1").Select 
End Sub 

ありがとう！ここで

Answer 1

は、あなたが何をしたいのかない、ややより直接的な方法でアプローチです：

Sub HighlightCell(Rng As Range, cFnd As String) 
    'highlights all nonoverlapping occurrences of cFnd in Rng (which is assumed to be a single cell) 
    Dim s As String 
    Dim i As Long, y As Long 
    y = Len(cFnd) 
    s = Rng.Value 
    With Rng 
     i = InStr(1, s, cFnd) 
     Do While i > 0 
      .Characters(Start:=i, Length:=y).Font.ColorIndex = 3 
      i = InStr(i + y + 1, s, cFnd) 
     Loop 
    End With 
End Sub 

Sub Highlight() 
    Application.ScreenUpdating = False 
    Dim Rng As Range 
    Dim cFnd As String 

    cFnd = InputBox("Search for?") 'so I could test without setting up the combobox 
    For Each Rng In Selection 
     HighlightCell Rng, cFnd 
    Next Rng 
    Application.ScreenUpdating = True 
End Sub 

次のスクリーンショットは、A1:B2が選択されている状態でコードを実行した結果を示している。ここで、検索語catです。それはケースsensitveであることに注意してください：ちょうどあなたのサブはそれがあった方法で行動していた理由を

、私は考えています。間違いなく、それはより直接的に見つけるのではなく、あなたが探していた文字列に分割していたやり方と関係があるでしょう。

Find methodを使用すると、関連するセルをさらに効率的に見つけることができますが、上記のコードでは、発生しているバグを修正する必要があります。

Answer 2

まあ、私は本当に馬鹿だと感じます。私が元来働いていたこと。他の列に奇妙な塗りつぶしが表示されたのは、新しい検索を行うたびにテキスト形式をクリアしていなかったからです。私がそれを変更すると、すべてが修正されました。