如何用VBA对比相邻单元格文本，通过InStr()定位修改新增内容字体

要实现你说的效果，核心是先把单元格文本拆成独立句子，比对找出A2独有的内容，再定位它的位置修改字体颜色。直接用InStr整段对比容易受空格、大小写干扰，拆分后比对更准确。

关键步骤说明 #

1. 拆分句子：把单元格里的文本按「句号+空格」拆成句子数组，同时清理掉多余的连续空格，避免比对出错。
2. 比对新增内容：遍历A2的所有句子，检查A1里是否存在（忽略大小写差异，比如Hello world和Hello World视为相同），找出A2独有的句子。
3. 定位并修改格式：在A2文本里找到新增句子的起始和结束位置，用Characters方法把这段文本的字体设为红色。

完整VBA代码 #

Sub MarkNewText()
    Dim cellA1 As Range, cellA2 As Range
    Dim textA1 As String, textA2 As String
    Dim sentencesA1 As Variant, sentencesA2 As Variant
    Dim i As Integer, startPos As Integer, endPos As Integer
    Dim targetSentence As String
    
    ' 定义要对比的相邻单元格（这里以A1和A2为例，可根据需求调整）
    Set cellA1 = ThisWorkbook.ActiveSheet.Range("A1")
    Set cellA2 = ThisWorkbook.ActiveSheet.Range("A2")
    
    textA1 = cellA1.Value
    textA2 = cellA2.Value
    
    ' 拆分文本为句子数组，处理多余空格
    sentencesA1 = SplitTextToSentences(textA1)
    sentencesA2 = SplitTextToSentences(textA2)
    
    ' 遍历A2的每个句子，找新增内容
    For i = LBound(sentencesA2) To UBound(sentencesA2)
        targetSentence = Trim(sentencesA2(i))
        If targetSentence = "" Then GoTo NextSentence ' 跳过空内容
        
        ' 检查A1中是否存在该句子（忽略大小写）
        If Not IsInArray(LCase(targetSentence), sentencesA1) Then
            ' 定位句子在A2中的起始位置
            startPos = InStr(1, textA2, targetSentence, vbTextCompare)
            If startPos > 0 Then
                endPos = startPos + Len(targetSentence) - 1
                ' 设置字体为红色
                cellA2.Characters(startPos, Len(targetSentence)).Font.Color = vbRed
            End If
        End If
NextSentence:
    Next i
End Sub

' 辅助函数：把文本拆成句子数组，清理连续空格
Function SplitTextToSentences(text As String) As Variant
    Dim cleanedText As String
    ' 替换多个连续空格为单个空格
    cleanedText = Replace(text, "  ", " ")
    Do While InStr(cleanedText, "  ") > 0
        cleanedText = Replace(cleanedText, "  ", " ")
    Loop
    ' 按「. 」拆分句子（如果你的句子分隔符不同，这里要调整）
    SplitTextToSentences = Split(cleanedText, ". ")
End Function

' 辅助函数：检查字符串是否在数组中（忽略大小写）
Function IsInArray(searchText As String, arr As Variant) As Boolean
    Dim element As Variant
    IsInArray = False
    For Each element In arr
        If LCase(Trim(element)) = searchText Then
            IsInArray = True
            Exit Function
        End If
    Next element
End Function

针对你的疑问解答 #

• 怎么把句子传入InStr：代码里把拆分后的每个句子（比如VBA is cool）作为targetSentence变量，用InStr(1, textA2, targetSentence, vbTextCompare)去查找它在A2文本里的位置，vbTextCompare参数可以忽略大小写。
• 怎么识别新增内容：通过IsInArray函数检查A2的句子是否在A1的句子数组里，不在的就是新增内容，再定位位置修改格式。

注意事项 #

• 如果你的句子不是用「句号+空格」分隔，要修改SplitTextToSentences函数里的拆分符（比如改成! 或? ）。
• 代码里默认忽略大小写差异，如果需要严格区分大小写，把LCase相关的代码删掉即可。

内容的提问来源于stack exchange，提问作者user22610270