A necessidade de um procv com retorno de todas as referências, a função do Benzadeus (http://www.ambienteoffice.com.br/excel/retornar_todas_as_correspondencias_de_um_PROCV/) e uma função de Adilson Soledade (http://www.planilhando.com.br/index.php?option=com_content&view=article&id=36:procv-turbinado-funcoes-personalizadas&catid=29:programacao-macros-vba&Itemid=64) respondem isso.
Tenho tentado turbinar uma função Procv que me retorne todas as ocorrências (separadas por vígula em uma mesma célula) de modo que haja um condicional para retornar somente de uma dado intervalo de tempo. Tenho as colunas: Cliente, Pedido, Data.
Ou seja, a fórmula que imagino deveria me fornecer todos os pedidos de um Cliente (escrito em uma célula de referência) em um intervalo de datas em uma coluna (não necessariamente ordenada sendo: datamin em uma célula e datamax em outra uma célula).
Se alguém tiver idéia de macro, também serve, pois o no fim vou bolar uma macro e um botão para isso, mais ainda, vou usar essa fórmula para buscar dados em uma outra pasta de trabalho que armazena esses dados (o que elimina o uso de filtros).
As funções originais (funcionam perfeitamente):
______________________________________________________________________________________________________________________________
'A função PROCVMÚLTIPLO(NomePesquisa; IntervaloPesquisa; IntervaloRetorno) pesquisa um valor num intervalo e retorna todas as ocorrências correspondentes num outro 'intervalo informado, separadas por ponto e vírgula.
Function PROCVMÚLTIPLO(NomePesquisa As String, IntervaloPesquisa As Range, IntervaloRetorno As Range) As String
Dim Valor, Nome
Dim k As Long
Application.Volatile
k = 1
For Each Nome In IntervaloPesquisa
If Nome = NomePesquisa Then
Valor = IntervaloRetorno(k, 1)
PROCVMÚLTIPLO = PROCVMÚLTIPLO & Valor & "; "
End If
k = k + 1
Next Nome
PROCVMÚLTIPLO = Left(PROCVMÚLTIPLO, Len(PROCVMÚLTIPLO) - 2)
End Function
______________________________________________________________________________________________________________________________
Function PROCVCONCAT(sProcura As String, vBD As Variant, lngOffset As Long)
'Altere essa constante se quiser utilizar outro caractere como dígito separador.
Const strSeparador As String = ";"
Dim l As Long
Dim lngTotal As Long
Dim strTemp() As String
Dim varTemp As Variant
'Transformo o parâmetro de entrada (que pode ser uma matriz ou uma Range) para trabalhar
'apenas com uma Variant:
varTemp = CVar(vBD)
For l = LBound(varTemp, 1) To UBound(varTemp, 1)
If varTemp(l, 1) = sProcura Then
'Foi encontrada uma correspondência na primeira coluna do vetor de varTemp.
lngTotal = lngTotal + 1
ReDim Preserve strTemp(1 To lngTotal)
strTemp(lngTotal) = varTemp(l, lngOffset)
End If
Next l
If IsArrayEmpty(strTemp) Then
'Caso não seja encontrada nenhuma correspondência, a função retornará uma célula vazia.
PROCVCONCAT = ""
Exit Function
Else
'Join concatena todas as correspondências encontradas do vetor strTemp:
PROCVCONCAT = Join(strTemp, strSeparador)
End If
_____________________________________________
End Function
Private Function IsArrayEmpty(v As Variant) As Boolean
On Error Resume Next
If LBound(v) <= UBound(v) Then
IsArrayEmpty = False
End If
If Err.Number > 0 Then IsArrayEmpty = True
End Function
______________________________________________________________________________________________________________________________
As funções que tenho errado:
*****************************************************************************************************************************************************************
'função PROCVCONDATA (procurado; tabela de procura; referência de saída;coluna da data; data min; datamax)
Function PROCVCONDATA(sProcura As String, vBD As Variant, lngOffset As Long, lngColunaData As Long, dtMin As Date, dtMax As Date)
'Altere essa constante se quiser utilizar outro caractere como dígito separador.
Const strSeparador As String = "; "
Dim l As Long
Dim lngTotal As Long
Dim strTemp() As String
Dim varTemp As Variant
'Transformo o parâmetro de entrada (que pode ser uma matriz ou uma Range) para trabalhar
'apenas com uma Variant:
varTemp = CVar(vBD)
For l = LBound(varTemp, 1) To UBound(varTemp, 1)
' o problema esta nesta linha
If varTemp(l, 1) = sProcura And varTemp(l, lngColunaData) <= dtMin And varTemp(l, lngColunaData) >= dtMax Then
'Foi encontrada uma correspondência na primeira coluna do vetor de varTemp.
lngTotal = lngTotal + 1
ReDim Preserve strTemp(1 To lngTotal)
strTemp(lngTotal) = varTemp(l, lngOffset)
End If
Next l
If IsArrayEmpty(strTemp) Then
'Caso não seja encontrada nenhuma correspondência, a função retornará uma mensagem.
PROCVCONDATA = "não encontrado"
Exit Function
Else
'Join concatena todas as correspondências encontradas do vetor strTemp:
PROCVCONDATA = Join(strTemp, strSeparador)
End If
End Function
End Function
Private Function IsArrayEmpty(v As Variant) As Boolean
On Error Resume Next
If LBound(v) <= UBound(v) Then
IsArrayEmpty = False
End If
If Err.Number > 0 Then IsArrayEmpty = True
End Function
***********************************************************************************************************************************************************
'função (procurado; coluna de procura; datamin; datamax; coluna da data; coluna da resposta)
Function PROCVMÚLTIPLODATA(NomePesquisa As String, IntervaloPesquisa As Range, datamin As Date, datamax As Date, IntervaloData As Range, IntervaloRetorno As Range) As String
Dim Valor, Nome, Data
Dim k As Long
Application.Volatile
k = 1
For Each Nome In IntervaloPesquisa
If Nome = NomePesquisa Then
' este comando abaixo usado desta forma é incorreto, mas desconheço aplicação similar
For Each Data In IntervaloData
If Data = datamin Then
For Each Data In IntervaloData
If Data = datamax Then
Valor = IntervaloRetorno(k, 1)
PROCVMÚLTIPLODATA = PROCVMÚLTIPLODATA & Valor & "; "
End If
k = k + 1
Next Nome
PROCVMÚLTIPLODATA = Left(PROCVMÚLTIPLODATA, Len(PROCVMÚLTIPLODATA) - 2)
End Function
--
André Evandro