EXCEL VBA 请帮我写一个代码

Sub Demo() Dim FindRng As Range Dim RltRng As Range Dim FirstAddress As String Dim TempString As String Dim i As Integer Set FindRng = Range("B1:H6") With FindRng On Error Resume Next Set RltRng = .Find(what:=Range("A7").Value, lookat:=xlWhole) If Not RltRng Is Nothing Then FindRng.Interior.Pattern = xlNone FirstAddress = RltRng.Address Do RltRng.Interior.Color = RGB(255, 240, 100) Set RltRng = .FindNext(RltRng) Loop While Not RltRng Is Nothing And RltRng.Address <> FirstAddress TempString = Right(Range("I1"), 14) & "同" Else FindRng.Interior.Pattern = xlNone TempString = Right(Range("I1"), 14) & "否" End If On Error GoTo 0 End With With Range("I1") .Value = TempString .Font.ColorIndex = xlAutomatic For i = 1 To Len(.Value) If Mid(.Value, i, 1) = "同" Then .Characters(Start:=i, Length:=1).Font.Color = -16776961 End If Next i End WithEnd Sub

把""和"A" 换一下位置试试。