Question

EXCEL VBA 帮忙写个代码

B1:H6的其中数值是否有和A7数值相同，有一个以上相同，就在I1最后一串字后加上红色"同"字、没有相同加黑色"否"字；I1单元格字串保持15个，超过15个将前面的字串去掉。(A7处的数值不是固定的，当A7数值变化时，点下按钮就达到上面的效果)

Answer 1

答：

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 With
End Sub