VBA增加提示:当查找内容已标记黄色时弹出提示框"已查找过"

zhenhao1989

VBA新增提示: 当查找内容已标记黄色时弹出提示框"已查找过"   求大神帮忙,谢谢!!

3190496160

Sub 查找()
    Dim arr, i As Long, mStr As String, m As Long, mRow As Long
    arr = Sheet1.UsedRange.Value
    mStr = arr(2, 2)
    For i = 8 To UBound(arr)
        If InStr(arr(i, 2), mStr) Then m = m + 1
    Next
    If m = 0 Then
        MsgBox "找不到关键词所在单元格！", 16 + 0, "提醒": End
    ElseIf m = 1 Then
        If Sheet1.AutoFilterMode = True Then Sheet1.AutoFilterMode = False
        mRow = Sheet1.Range("B8:B" & UBound(arr)).Find(mStr).Row
        If Sheet1.Rows(mRow).Interior.ColorIndex = 6 Then MsgBox "已查找过！": Exit Sub
        Sheet1.Rows(mRow).Interior.ColorIndex = 6
        Sheet1.Range("B" & mRow).Select
    ElseIf m > 1 Then
        Sheet1.Range("A7:G7").AutoFilter Field:=1
        ActiveSheet.Range("A7:G" & UBound(arr)).AutoFilter Field:=2, Criteria1:="=*" & mStr & "*"
    Else
        End
    End If
End Sub

ggmmlol

本问题用EXCEL本身内置的“查找”功能就可以解决，而且效率也是最高的，写VBA代码完全是多此一举。

因为内置的查找功能，可以把单元格的的格式设置为附加条件进行查找。

zhenhao1989

3190496160 发表于 2020-3-17 08:44
Sub 查找()
    Dim arr, i As Long, mStr As String, m As Long, mRow As Long
    arr = Sheet1.UsedRa ...

谢谢大神,太有帮助了

opel-wong

3190496160 发表于 2020-3-17 08:44
Sub 查找()
    Dim arr, i As Long, mStr As String, m As Long, mRow As Long
    arr = Sheet1.UsedRa ...

这段代码，我怎么看着这么眼熟呢？
仔细看看，你按楼主的要求添加了一句。

zhenhao1989

opel-wong 发表于 2020-3-17 11:55
这段代码，我怎么看着这么眼熟呢？
仔细看看，你按楼主的要求添加了一句。

恩 这个VBA一开始就是你帮我写的啊.