VBA搜索函数仅返回首个匹配单元格地址及获取表头需求求助

一、修改代码返回所有匹配单元格地址 #

原函数仅返回第一个匹配项，是因为Find方法默认只查找第一个结果。要获取所有匹配，需要结合FindNext循环遍历，直到回到第一个匹配单元格避免死循环。修改后的代码如下：

Function FindValueInCellRange(MyRange As Range, MyValue As Variant) As String
    Dim foundCell As Range
    Dim firstAddress As String
    Dim result As String
    
    With MyRange
        Set foundCell = .Find(What:=MyValue, After:=.Cells(.Cells.Count), _
            LookIn:=xlFormulas2, LookAt:=xlPart, SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        
        If Not foundCell Is Nothing Then
            firstAddress = foundCell.Address
            Do
                ' 拼接相对引用的单元格地址
                result = result & foundCell.Address(RowAbsolute:=False, ColumnAbsolute:=False) & ", "
                Set foundCell = .FindNext(foundCell)
            ' 循环至回到第一个匹配单元格，终止循环
            Loop While Not foundCell Is Nothing And foundCell.Address <> firstAddress
            
            ' 移除末尾多余的逗号和空格
            If Len(result) > 0 Then
                result = Left(result, Len(result) - 2)
            End If
        Else
            ' 无匹配时返回提示
            result = "未找到匹配内容"
        End If
    End With
    
    FindValueInCellRange = result
End Function

二、替换为对应单元格的表头名称 #

如果要用表头名称替代单元格地址，需要先明确表头的位置（以下代码默认表头在工作表的第一行，可根据实际情况调整）：

Function FindValueWithHeader(MyRange As Range, MyValue As Variant) As String
    Dim foundCell As Range
    Dim firstAddress As String
    Dim result As String
    Dim headerCell As Range
    
    With MyRange
        Set foundCell = .Find(What:=MyValue, After:=.Cells(.Cells.Count), _
            LookIn:=xlFormulas2, LookAt:=xlPart, SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        
        If Not foundCell Is Nothing Then
            firstAddress = foundCell.Address
            Do
                ' 获取当前匹配单元格所在列的表头（工作表第一行）
                Set headerCell = MyRange.Parent.Cells(1, foundCell.Column)
                ' 若表头为空，用列标替代
                If headerCell.Value = "" Then
                    result = result & headerCell.Address(RowAbsolute:=False, ColumnAbsolute:=False) & ", "
                Else
                    result = result & headerCell.Value & ", "
                End If
                
                Set foundCell = .FindNext(foundCell)
            Loop While Not foundCell Is Nothing And foundCell.Address <> firstAddress
            
            If Len(result) > 0 Then
                result = Left(result, Len(result) - 2)
            End If
        Else
            result = "未找到匹配内容"
        End If
    End With
    
    FindValueWithHeader = result
End Function

表头位置调整说明 #

如果表头不在工作表第一行，比如在MyRange的上一行，可将Set headerCell = ...这行改为：

Set headerCell = MyRange.Parent.Cells(MyRange.Row - 1, foundCell.Column)

如果MyRange本身包含表头（即MyRange的第一行是表头），则改为：

Set headerCell = MyRange.Cells(1, foundCell.Column - MyRange.Column + 1)

内容的提问来源于stack exchange，提问作者jaga jagga