用于查找值的所有匹配项的函数

问题描述 投票:0回答:2

我需要您的帮助。

[抱歉,我真的是VBA的新手,但是我该如何转换或添加到下面的Excel函数中以遍历所有找到的匹配项。现在,它仅返回1个匹配项,但我想对其进行修改以返回所有匹配项,以便我可以将其输入到用户表单中以便以后处理。

Private Sub Search_Click()

    With Sheet1
        Set foundCell = .Cells.find(What:="test", After:=.Cells(1, 1), _
        LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
    End With

If Not foundCell Is Nothing Then
        MsgBox ("""Match"" found in row " & foundCell.Row)
        form1.location.Value = Cells(foundCell.Row, 1).Value
Else
        MsgBox ("No match not found")
End If

End Sub
excel vba
2个回答
2
投票

您可以尝试findnext或添加一些类似这些内容的小修改,只是一个连续的循环,直到您用尽了所有匹配项

Private Sub Search_Click()

    Dim rowNum As Long: rowNum = 1
    Dim colNum As Long: colNum = 1

    Do While ( True )

        With Sheet1
            Set foundCell = .Cells.find(What:="test", After:=.Cells(rowNum, colNum), _
            LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        End With

        If Not foundCell Is Nothing Then
            MsgBox ("""Match"" found in row " & foundCell.Row)
            form1.location.Value = form1.location.Value & vbCrLf & Cells(foundCell.Row, 1).Value
            if foundCell.Row < rowNum Then Exit Do
            rowNum = foundCell.Row
            colNum = foundCell.Column
        Else
            If rowNum = 1 Then MsgBox ("No matches found")
            Exit Do
        End If

    Loop

End Sub

0
投票

如果您需要存储包含搜索项的所有单元格的数据,则可以使用以下内容。用法:myArray = makeArrayFoundCellInfoInRange(“ test”,Sheets。(“ Sheet1”)。Range(“ A1:Z500”))]

'**************************************************************************************************************************************************************
'To return an array of information (value, formula, address, row, and column) for all the cells from a specified Range that have the searched item as value
'Returns an empty array if there is an error or no data
'**************************************************************************************************************************************************************
Public Function makeArrayFoundCellInfoInRange(ByVal itemSearched As Variant, ByVal aRange As Variant) As Variant
Dim cell As Range, tmpArr As Variant, x As Long

tmpArr = Array()
If TypeName(aRange) = "Range" Then
    x = 0
    For Each cell In aRange
        If itemSearched = cell.Value Then
            If x = 0 Then
                ReDim tmpArr(0 To 0, 0 To 4)
            Else
                tmpArr = reDimPreserve(tmpArr, UBound(tmpArr, 1) + 1, UBound(tmpArr, 2))
            End If
            tmpArr(x, 0) = cell.Value
            tmpArr(x, 1) = cell.Formula
            tmpArr(x, 2) = cell.Address(0, 0) 'Without the dollar signs
            tmpArr(x, 3) = cell.Row
            tmpArr(x, 4) = cell.Column
            x = x + 1
        End If
    Next cell
End If
makeArrayFoundCellInfoInRange = tmpArr
Erase tmpArr

End Function
© www.soinside.com 2019 - 2024. All rights reserved.