EXCEL中，如何把A列中存在于B列的关键字加粗并修改字体？

Question

如图。如果a列中有存在于b列的关键字，就把它加粗并设置为黑体。
注意，仅把关键字加粗，而不是整个单元格。字符长度也不仅局限于一个字符。
如何用vba或函数实现？谢谢大家！

Answer 1

Vba的代码如下：

Sub 加粗()

Dim EndRow As Long

EndRow = Sheet5.Cells(Sheet5.Rows.Count, 1).End(xlUp).Row

For i = 1 To EndRow

    For j = 1 To Len(Sheet5.Range("A" & i))

       If Mid(Sheet5.Range("A" & i), j, 1) = Sheet5.Range("B" & i) Then

            With Sheet5.Range("A" & i).Characters(Start:=j, Length:=1).Font

                .Name = "黑体"

                .FontStyle = "加粗"

            End With

       End If

    Next j

Next i

End Sub

效果如下：

追问

请问如何突破单字符限制？

另外a列b列不是一行对一行的关系，b列相当于一个库，a列中凡是包含了b列的关键字，都加粗。

追答

先给你一一对应的突破单字符宏，你下次追问的时候给你写你要的 B列是库的加粗。如果好记得采用。谢谢。

Sub 加粗()

Dim EndRow, FLen, FIndex, RInt As Long

Dim TStr As String

EndRow = Sheet3.Cells(Sheet3.Rows.Count, 1).End(xlUp).Row

For i = 1 To EndRow

FLen = Len(Sheet3.Range("B" & i))

TStr = Sheet3.Range("A" & i)

RInt = 0

Do

FIndex = InStr(TStr, Sheet3.Range("B" & i))

If FIndex > 0 Then

If RInt = 0 Then

RInt = RInt + FIndex

Else

RInt = RInt + FIndex + FLen - 1

End If

With Sheet3.Range("A" & i).Characters(Start:=RInt, Length:=FLen).Font

.Name = "黑体"

.FontStyle = "加粗"

End With

TStr = Mid(TStr, InStr(TStr, Sheet3.Range("B" & i)) + FLen, Len(TStr) - FLen)

Else

Exit Do

End If

Loop Until Len(TStr) < FLen

Next i

End Sub

追问

大神太厉害了，我需要B列是关键字库的加粗。我再追加金币。感谢了。

追答

正好在线，贴给你。

Sub 加粗()
Dim EndRow, FLen, FIndex, RInt, KRow As Long
Dim TStr As String
EndRow = Sheet3.Cells(Sheet3.Rows.Count, 1).End(xlUp).Row
KRow = Sheet3.Cells(Sheet3.Rows.Count, 2).End(xlUp).Row
For i = 1 To EndRow
For j = 1 To KRow
FLen = Len(Sheet3.Range("B" & j))
TStr = Sheet3.Range("A" & i)
RInt = 0
Do
FIndex = InStr(TStr, Sheet3.Range("B" & j))
If FIndex > 0 Then
If RInt = 0 Then
RInt = RInt + FIndex
Else
RInt = RInt + FIndex + FLen - 1
End If
With Sheet3.Range("A" & i).Characters(Start:=RInt, Length:=FLen).Font
.Name = "黑体"
.FontStyle = "加粗"
End With
TStr = Mid(TStr, InStr(TStr, Sheet3.Range("B" & j)) + FLen, Len(TStr) - FLen)
Else
Exit Do
End If
Loop Until Len(TStr) < FLen
Next j
Next i
End Sub

追问

非常感谢，一次成功，厉害了

追答

不客气，还有，就是更改字体颜色和大小。
.Size = 22'改大小
.Color = RGB(0, 255, 0)'改颜色
修改下面部分代码就可以。
With Sheet3.Range("A" & i).Characters(Start:=RInt, Length:=FLen).Font
.Name = "黑体"
.FontStyle = "加粗"
.Size = 22
.Color = RGB(0, 255, 0)
End With

追问

非常感谢

Answer 2

Vba的代码如下：

Sub 加粗()

Dim EndRow As Long

EndRow = Sheet5.Cells(Sheet5.Rows.Count, 1).End(xlUp).Row

For i = 1 To EndRow

For j = 1 To Len(Sheet5.Range("A" & i))

If Mid(Sheet5.Range("A" & i), j, 1) = Sheet5.Range("B" & i) Then

With Sheet5.Range("A" & i).Characters(Start:=j, Length:=1).Font

.Name = "黑体"

.FontStyle = "加粗"

End With

End If

Next j

Next i

End Sub

效果如下：追问

你干嘛盗用别人的回答，可耻