☰

用于多个输入搜索比较的 VBA 代码

tag-icon • tag-icon microsoft-excel worksheet-function microsoft-excel-2010 vba microsoft-excel-2007
用于多个输入搜索比较的 VBA 代码

我需要使用宏从 Excel 中的数据中进行搜索

图片:

例如上图是默认列表，并且我使用输入框进行了输入。

  • 案例：1 如果输入“a1，a2，b1，c4”，则应显示“所有数据均正确”

  • 案例：2 如果输入是“a1，a2，b5，c5，c4”，它应该反映“错误：b5＆c5不可用”并且应该再次运行循环直到完美匹配（如案例1中所示）

答案1

尝试下面的代码。它要求输入标题，然后检查是否正确。如果有些不正确，则消息框显示不正确的图块。然后，再次显示输入框以输入标题。如果标题正确，则显示消息框，然后退出循环。

Sub FindTitles()


    Dim blnCorrect, blnFound As Boolean
    Dim myarray
    Dim myinput, notitle As String
    Dim lRow, mybound As Long
    
    'Find the last non-blank cell in column A(1)
    lRow = Cells(Rows.Count, 1).End(xlUp).Row

    'Loop while entered values are incorrect
    Do While blnCorrect = False
        'Get the titles
        myinput = InputBox("Enter titles", "Titles")
        myarray = Split(myinput, ",")
        mybound = UBound(myarray) - LBound(myarray) + 1
    
        notitle = ""
        'Loop through the entered titles
        For x = 0 To mybound - 1
            'Loop through the titles on the worksheet
            For Each mycells In Range("A2:A" & lRow)
                'If title is found, exit the loop
                If mycells.Value = myarray(x) Then
                    blnFound = True
                    Exit For
                Else
                    blnFound = False
                End If
                            
            Next
    
            If Not blnFound Then
                'Append the title not found
                notitle = notitle & myarray(x) & " & "
            End If
    
        Next
    
        If notitle = "" Then
       
            MsgBox Prompt:="All titles are available", Title:="Title(s) found"
            'Set blnCorrect to True to exit the loop
            blnCorrect = True
        Else
            notitle = Left(notitle, (Len(notitle) - 3))
            MsgBox Prompt:= " Error: " & notitle & " are not available", Title:="Title(s) not found"
        End If
    
    Loop

End Sub

相关内容