............ Foro Excel
Si no lo has hecho aún: REGISTRATE!!!

UDF para obtener lista de referencias de todas las apariciones totales o parciales en un rango

Ver el tema anterior Ver el tema siguiente Ir abajo

UDF para obtener lista de referencias de todas las apariciones totales o parciales en un rango

Mensaje por GalileoGali el Dom Abr 27, 2008 11:21 am

Esta UDF (User Defined Function) está aun en etapa borrador. Seguramente, hay muchas otras maneras de lograr lo mismo.
Dejo este codigo con la intención de que lo Optimicemos entre todos. Quedo al aguardo de vuestras sugerencias, comentarios o reformulaciones, particularmente encaminadas a lograr un buen "Manejo de errores" (error handling). Y ¿por qué no? a eliminar o depurar codigo innecesario.

Hoja1

 ABCDEF
176  Busqueda6 
2r66 1$A$1$B$4
3t 82$B$2$A$6
4 6 3$B$4$C$6
5   4$A$6#N/A
66 65$C$6#N/A
7      
Spreadsheet Formulas
CellFormula
E2=buscaref($A$1:$C$7;$E$1;D2;VERDADERO)
F2=buscaref($A$1:$C$7;$E$1;D2;FALSO)
E3=buscaref($A$1:$C$7;$E$1;D3;VERDADERO)
F3=buscaref($A$1:$C$7;$E$1;D3;FALSO)
E4=buscaref($A$1:$C$7;$E$1;D4;VERDADERO)
F4=buscaref($A$1:$C$7;$E$1;D4;FALSO)
E5=buscaref($A$1:$C$7;$E$1;D5;VERDADERO)
F5=buscaref($A$1:$C$7;$E$1;D5;FALSO)
E6=buscaref($A$1:$C$7;$E$1;D6;VERDADERO)
F6=buscaref($A$1:$C$7;$E$1;D6;FALSO)


Excel tables to the web >> [Tienes que estar registrado y conectado para ver este vínculo]



Primer Argumento: Zona de busqueda como Range
2do Argumento: Valor buscado, como variant
Tercer Argumento: Considerando el Rango como barrido fila a fila. N representa la n-esima ocurrencia del Valor buscado
4to Argumento: FALSO o "0" para que valor y valor en celda sean iguales, VERDADERO o "1" para coincidencia parcial
Código:

Option Compare Text
Function BuscaRef(rng As Range, vQue As Variant, n As Long, bEntParcial As Boolean) As String
Dim rngFind As Range
Dim lngEncontrado As Long
Dim parcial As Byte
Dim result
Dim strWhat As String


Application.Volatile
If bEntParcial Then
 If n > ActiveSheet.Evaluate("SUMPRODUCT(--(ISNUMBER(FIND(" & vQue & "," & rng.Address & "))))") Or n < 1 Then
        BuscaRef = "#N/A"
        Exit Function
End If
Else
If n > Application.CountIf(rng, vQue) Or n < 1 Then
BuscaRef = "#N/A"
Exit Function
End If
End If
If Not (bEntParcial) Then
If rng(1, 1).Value = vQue Then
lngEncontrado = lngEncontrado + 1
Set rngFind = rng(1, 1)
End If
Else
If CStr(rng(1, 1).Value) Like "*" & CStr(vQue) & "*" Then
lngEncontrado = lngEncontrado + 1
Set rngFind = rng(1, 1)
End If
End If
parcial = IIf(bEntParcial, 1, 0) + 1
If lngEncontrado < n Then

Set rngFind = rng.Cells.Find(What:=vQue, LookIn:=xlValues, LookAt:=parcial, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False)
lngEncontrado = lngEncontrado + 1

Do While lngEncontrado < n

Set rngFind = rng.Cells.Find(What:=vQue, After:=rngFind, LookIn:=xlValues, LookAt:=parcial, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False)

lngEncontrado = lngEncontrado + 1
Loop

End If
BuscaRef = rngFind.Address

End Function
Gracias

_________________
GalileoGali
M.A.P. 2010-2013
Microsoft Active Professional
avatar
GalileoGali
Admin

Masculino Cantidad de envíos : 1963
Edad : 62
Ciudad - Pais : QUIROGA, Argentina
Version de Excel : 2000-2003-2007-2010
Fecha de inscripción : 24/01/2008

http://excelgali.mejorforo.net

Volver arriba Ir abajo

Ver el tema anterior Ver el tema siguiente Volver arriba


 
Permisos de este foro:
No puedes responder a temas en este foro.