コード1

Sub HighlightCell()
If Range("B1") < 0 Then
    Dim searchString As String
    Dim searchRange As Range
    Dim cell As Range
    Dim startPos As Long
    Dim foundPos As Long
    ' 検索する文字列をB1セルから取得
    searchString = Range("B1").Value
    ' 検索範囲をA1セルから設定
    Set searchRange = Range("A1")
    ' 検索範囲内の各セルをループで処理
    For Each cell In searchRange
        startPos = 1
        ' セルの値を検索文字列で検索
        foundPos = InStr(startPos, cell.Value, searchString, vbTextCompare)
        ' セル内で検索文字列が見つかる場合
        Do While foundPos > 0
            ' セルのフォント色を赤に設定
            cell.Characters(foundPos, Len(searchString)).Font.Color = RGB(255, 0, 0)
            ' 次の検索位置を設定
            startPos = foundPos + 1
            ' 検索文字列をセル内で再検索
            foundPos = InStr(startPos, cell.Value, searchString, vbTextCompare)
        Loop
    Next cell
Else
    Dim searchString1 As String
    Dim searchRange1 As Range
    Dim cell1 As Range
    Dim startPos1 As Long
    Dim foundPos1 As Long
    
    ' 検索する文字列をB1セルから取得
    searchString1 = Range("B1").Value
    
    ' 検索範囲をA1セルから設定
    Set searchRange1 = Range("A1")
    
    ' 検索範囲内の各セルをループで処理
    For Each cell1 In searchRange1
        startPos1 = 1
        
        ' セルの値を検索文字列で検索
        foundPos1 = InStr(startPos1, cell1.Value, searchString1, vbTextCompare)
        
        ' セル内で検索文字列が見つかる場合
        Do While foundPos1 > 0
            ' セルのフォント色を赤に設定
            cell1.Characters(foundPos1, Len(searchString1)).Font.Color = RGB(0, 0, 255)
            
            ' 次の検索位置を設定
            startPos1 = foundPos1 + 1
            
            ' 検索文字列をセル内で再検索
            foundPos1 = InStr(startPos1, cell1.Value, searchString1, vbTextCompare)
        Loop
    Next cell1
End If
' B2セルも同じ処理
If Range("B2") < 0 Then
    Dim searchString2 As String
    Dim searchRange2 As Range
    Dim cell2 As Range
    Dim startPos2 As Long
    Dim foundPos2 As Long
    
    ' 検索する文字列をB2セルから取得
    searchString2 = Range("B2").Value
    
    ' 検索範囲をA1セルから設定
    Set searchRange2 = Range("A1")
    
    ' 検索範囲内の各セルをループで処理
    For Each cell2 In searchRange2
        startPos2 = 1
        
        ' セルの値を検索文字列で検索
        foundPos2 = InStr(startPos2, cell2.Value, searchString2, vbTextCompare)
        
        ' セル内で検索文字列が見つかる場合
        Do While foundPos2 > 0
            ' セルのフォント色を赤に設定
            cell2.Characters(foundPos2, Len(searchString2)).Font.Color = RGB(255, 0, 0)
            
            ' 次の検索位置を設定
            startPos2 = foundPos2 + 1
            
            ' 検索文字列をセル内で再検索
            foundPos2 = InStr(startPos2, cell2.Value, searchString2, vbTextCompare)
        Loop
    Next cell2
Else
    Dim searchString3 As String
    Dim searchRange3 As Range
    Dim cell3 As Range
    Dim startPos3 As Long
    Dim foundPos3 As Long
    
    ' 検索する文字列をB2セルから取得
    searchString3 = Range("B2").Value
    
    ' 検索範囲をA1セルから設定
    Set searchRange3 = Range("A1")
    
    ' 検索範囲内の各セルをループで処理
    For Each cell3 In searchRange3
        startPos3 = 1
        
        ' セルの値を検索文字列で検索
        foundPos3 = InStr(startPos3, cell3.Value, searchString3, vbTextCompare)
        
        ' セル内で検索文字列が見つかる場合
        Do While foundPos3 > 0
            ' セルのフォント色を赤に設定
            cell3.Characters(foundPos3, Len(searchString3)).Font.Color = RGB(0, 0, 255)
            
            ' 次の検索位置を設定
            startPos3 = foundPos3 + 1
            
            ' 検索文字列をセル内で再検索
            foundPos3 = InStr(startPos3, cell3.Value, searchString3, vbTextCompare)
        Loop
    Next cell3
End If
End Sub