Função que retorna array

[andersonrich]

Gostaria que a função abaixo retornasse todos os resultados encontrados. Cada resultado em uma célula diferente. Obrigado.

 

Function BuscaVertical(intervalo As Range, palavra As String) As Variant


Dim c As Object
Dim a
Dim posicao As Long

posicao = 0

For Each c In intervalo.Cells

If palavra = c.Value Then

a(posicao) = palavra

posicao = posicao + 1
End If


Next c


BuscaVertical = a
End Function

 

[Alyson Ronnan Martins]

Boa tarde @andersonrich

Como não tenho uma base de dados para testar meu código olha se esse código resolveu o que precisa:
 

Function BuscaVertical(intervalo As Range, palavra As String) As Variant
    Dim c As Object
    Dim a() As Variant
    Dim posicao As Long

    posicao = 0

    ' Redimensiona o array para garantir espaço suficiente
    ReDim a(1 To 1)

    For Each c In intervalo.Cells
        If palavra = c.Value Then
            ' Redimensiona o array para armazenar o novo valor encontrado
            posicao = posicao + 1
            ReDim Preserve a(1 To posicao)
            a(posicao) = palavra
        End If
    Next c

    BuscaVertical = a
End Function

 

[andersonrich]

Muito obrigado amigo. Deu erro #valor não retornou nenhum resultado.