Search a range of word from a paragraph

帅比萌擦擦* 提交于 2021-02-11 14:01:32

问题


I have a list of word. i want to mark that word within a paragraph if match. if word match then want to change the color.

I am trying this code:

Sub HighlightStrings()
Application.ScreenUpdating = False
Dim rng As Range
Dim InputRang As Range
Dim cFnd As String
Dim xTmp As String
Dim x As Long
Dim celValue As String
Dim m As Long
Dim y As Long
Dim xFNum As Integer
Dim xArrFnd As Variant
Dim xStr As String

celValue = Range("A1").Value
cFnd = celValue
If Len(cFnd) < 1 Then Exit Sub
xArrFnd = Split(cFnd, ";")
For Each rng In Selection
With rng
For xFNum = 0 To UBound(xArrFnd)
xStr = xArrFnd(xFNum)
y = Len(xStr)
m = UBound(Split(rng.Value, xStr))
If m > 0 Then
xTmp = ""
For x = 0 To m - 1
xTmp = xTmp & Split(rng.Value, xStr)(x)
.Characters(Start:=Len(xTmp) + 1, Length:=y).Font.ColorIndex = 3
.Characters(Start:=Len(xTmp) + 1, Length:=y).Font.Bold = True
xTmp = xTmp & xStr
Next
End If
Next xFNum
End With
Next rng
Application.ScreenUpdating = True
End Sub

But this code getting one word. i need range of word with semicolon separate. for example, "hello;paragraph;bold;words"


回答1:


I solve my problem myself. Need to add this code:

Dim arr
    arr = Join(Application.Transpose(Range("A1:A4").Value), ";")

Full Code:

Sub HighlightStrings()
Application.ScreenUpdating = False
Dim rng As Range
Dim InputRang As Range
Dim cFnd As String
Dim xTmp As String
Dim x As Long
Dim m As Long
Dim y As Long
Dim xFNum As Integer
Dim xArrFnd As Variant
Dim xStr As String
Dim arr

arr = Join(Application.Transpose(Range("A1:A4").Value), ";")
cFnd = arr

If Len(cFnd) < 1 Then Exit Sub
xArrFnd = Split(cFnd, ";")
    For Each rng In Selection
        With rng
            For xFNum = 0 To UBound(xArrFnd)
            xStr = xArrFnd(xFNum)
            y = Len(xStr)
            m = UBound(Split(rng.Value, xStr))
                If m > 0 Then
                xTmp = ""
                    For x = 0 To m - 1
                    xTmp = xTmp & Split(rng.Value, xStr)(x)
                    .Characters(Start:=Len(xTmp) + 1, Length:=y).Font.ColorIndex = 3
                    .Characters(Start:=Len(xTmp) + 1, Length:=y).Font.Bold = True
                    xTmp = xTmp & xStr
                    Next
                End If
            Next xFNum
        End With
    Next rng
Application.ScreenUpdating = True
End Sub


来源:https://stackoverflow.com/questions/61573596/search-a-range-of-word-from-a-paragraph

标签
易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!