Extraer desde la derecha hasta encontrar un caracter en concreto.

Hola jose,

La funcion StrReverse esta disponible a partir del Office2000. Prueba esto:

Sub test()
Dim msg As String, Nombres, i As Long
Nombres = Array( _
"nombredearchivo.jpg", _
"nombredearchivo.jp", _
"nombre.de.archivo.jpge", _
"nombre de .archivo.con-espacios y de tooo.t")
For i = 0 To UBound(Nombres)
msg = msg & Right(Nombres(i), InStr(StrReverse(Nombres(i)), ".") - 1) & Chr(13)
Next i
MsgBox msg
End Sub


Saludos,
KL


"~ jose ~" wrote in message news:
Hola, que hay?

Tengo un problemilla que le estoy dando vueltas...
como se puede extraer los caracteres que hay en un texto desde la
derecha hasta un caracter especifico?
Quiero extraer la extensión de un archivo,
me explico con ejemplo.

nombredearchivo.jpg resultado jpg
nombredearchivo.jp resultado jp
nombre.de.archivo.jpge resultado jpge
nombre de .archivo.con-espacios_y de tooo.t resultado t

Habia pensado en poner al reves el texto con VB en cualquier celda y
con una función seria muy facil encontar el "." y extraer los datos, y
luego volverlo a revertir, me suena de que hay por ahi algun codigo que
hace eso pero no lo encuentro.

ejemplo
gpj.ovihcraederbmon resultado jpg

Un saludo

Hola KL,
mmmm, pues esto no me sirve de mucho, dado que el resultado es un MSG y
los nombres de archivos están en el código.
Lo bueno seria que se sacaran los datos desde las celdas (de dá igual
cuales) y el resultado en otras.

Pero bueno, a pesar de mi inexperiencia con VB, mañana probaré a
modificar un poco este código.
Si quieres expones el resultado y yo lo miraré si no logro mi
resultado, (que casi seguro que lo miro) jejeje

Una pregunta, esto que hablamos se puede hacer desde una función (o
varias funciones)?

Un saludo,
jose
KL wrote:

Hola jose,

La funcion StrReverse esta disponible a partir del Office2000. Prueba esto:

Sub test()
Dim msg As String, Nombres, i As Long
Nombres = Array( _
"nombredearchivo.jpg", _
"nombredearchivo.jp", _
"nombre.de.archivo.jpge", _
"nombre de .archivo.con-espacios y de tooo.t")
For i = 0 To UBound(Nombres)
msg = msg & Right(Nombres(i), InStr(StrReverse(Nombres(i)), ".") - 1) & Chr(13)
Next i
MsgBox msg
End Sub


Saludos,
KL


"~ jose ~" wrote in message news:
Hola, que hay?

Tengo un problemilla que le estoy dando vueltas...
como se puede extraer los caracteres que hay en un texto desde la
derecha hasta un caracter especifico?
Quiero extraer la extensión de un archivo,
me explico con ejemplo.

nombredearchivo.jpg resultado jpg
nombredearchivo.jp resultado jp
nombre.de.archivo.jpge resultado jpge
nombre de .archivo.con-espacios_y de tooo.t resultado t

Habia pensado en poner al reves el texto con VB en cualquier celda y
con una función seria muy facil encontar el "." y extraer los datos, y
luego volverlo a revertir, me suena de que hay por ahi algun codigo que
hace eso pero no lo encuentro.

ejemplo
gpj.ovihcraederbmon resultado jpg

Un saludo

Te habia entendido que lo querias usar desde VBA. Si necesitas hacerlo en la hoja, entonces prueba las siguientes opciones:

Opcion 1: Usa la siguiente formula:

ÞRECHA(A1;LARGO(A1)-ENCONTRAR("|";SUSTITUIR(A1;".";"|";LARGO(A1)-LARGO(SUSTITUIR(A1;".";"")))))


Opcion 2: Funcion definida por el usuario (UDF):

Copia el siguiente codigo en un modulo estandar del libro en cuestion (p.ej. Modulo1):

Function Extension(ByVal Nombre As String) As String
Extension = Right(Nombre, InStr(StrReverse(Nombre), ".") - 1)
End Function

y luego usa la funcion desde cualquier celda usando la siguiente sintaxis:

=Extension(A1)


Saludos,
KL


"~ jose ~" wrote in message news:
Hola KL,
mmmm, pues esto no me sirve de mucho, dado que el resultado es un MSG y
los nombres de archivos están en el código.
Lo bueno seria que se sacaran los datos desde las celdas (de dá igual
cuales) y el resultado en otras.

Pero bueno, a pesar de mi inexperiencia con VB, mañana probaré a
modificar un poco este código.
Si quieres expones el resultado y yo lo miraré si no logro mi
resultado, (que casi seguro que lo miro) jejeje

Una pregunta, esto que hablamos se puede hacer desde una función (o
varias funciones)?

Un saludo,
jose
KL wrote:

Hola jose,

La funcion StrReverse esta disponible a partir del Office2000. Prueba esto:

Sub test()
Dim msg As String, Nombres, i As Long
Nombres = Array( _
"nombredearchivo.jpg", _
"nombredearchivo.jp", _
"nombre.de.archivo.jpge", _
"nombre de .archivo.con-espacios y de tooo.t")
For i = 0 To UBound(Nombres)
msg = msg & Right(Nombres(i), InStr(StrReverse(Nombres(i)), ".") - 1) & Chr(13)
Next i
MsgBox msg
End Sub


Saludos,
KL


"~ jose ~" wrote in message news:
Hola, que hay?

Tengo un problemilla que le estoy dando vueltas...
como se puede extraer los caracteres que hay en un texto desde la
derecha hasta un caracter especifico?
Quiero extraer la extensión de un archivo,
me explico con ejemplo.

nombredearchivo.jpg resultado jpg
nombredearchivo.jp resultado jp
nombre.de.archivo.jpge resultado jpge
nombre de .archivo.con-espacios_y de tooo.t resultado t

Habia pensado en poner al reves el texto con VB en cualquier celda y
con una función seria muy facil encontar el "." y extraer los datos, y
luego volverlo a revertir, me suena de que hay por ahi algun codigo que
hace eso pero no lo encuentro.

ejemplo
gpj.ovihcraederbmon resultado jpg

Un saludo

Hola Jose
Tengo una función en VBA que permite indicar cualquier caracter como
"Separador de Campo" lo que permite extraer cualquier campo de una
cadena de caracteres. Con alguna pequeña modificación podría hacer
alguna cosa más.
Pej. si la cadena es AAAB.CCCCH.AKL si le indicas que el separador
es "A" y que te extraiga el campo 4, te devolvería B.CCCCH. si le
indicas que el separador es "." al extraer el campo 1 sería AAAB.

Si la quieres, el código es
-
Function ExtCmp(Celda As String, iSepCmp As String, Cmp As Integer) As
String
' Extrae una cadena de otra cadena que esté comprendida entre dos
identificadores
' Celda = Referencia de la celda
' iSepCmp = Caracter identificador de separación
' Cmp = Nº de Campo a extraer (Nº máximo de campos, 64)
'--
Dim POSi(64) As Long
Dim Idx As Integer
Dim NCar As Integer
Dim POS1, POS2 As Long
PalabrasClaveF = "F,FINAL,U,ULTIMO,"
PalabrasClaveP = "P,PRIMERO,PRIMER,INICIO,I,INICIAL,"
Cmp = UCase$(Cmp)
If Val(Cmp) = 0 Then
' If Cmp = "F" Or Cmp = "FINAL" Or Cmp = "U" Or Cmp = "ULTIMO" Then
' Cmp = "U"
' Else
' If Cmp = "P" Or Cmp = "PRIMER" Or Cmp = "PRIMERO" Or Cmp = "I"
Or Cmp = "INICIO" Or Cmp = "INICIAL" Then
' Cmp = "P"
' End If
' End If
If InStr(1, PalabrasClaveF, Cmp & ",") <> 0 Then
Cmp = "U"
Else
If InStr(1, PalabrasClaveP, Cmp & ",") <> 0 Then
Cmp = "P"
Else
Cmp = 0
End If
End If
Else
If Cmp > 64 Then ExtCmp = "Error:++Cmp": GoTo Fin
If Cmp < 1 Then ExtCmp = "Error:--Cmp": GoTo Fin
End If
For i = 1 To 64: POSi(i) = Len(Celda): Next i

'Cuenta Caracteres Separadores
NCar = 1: Idx = 0: POSi(1) = 1
While NCar <= Len(Celda)
If Mid$(Celda, NCar, 1) = iSepCmp Then
Idx = Idx + 1
POSi(Idx) = NCar
End If
NCar = NCar + 1
Wend
'Idx queda definido como número de campos
If Cmp = "P" Then Cmp = 1
If Cmp = "U" Then Cmp = Idx + 1
If Cmp > Idx + 1 Then ExtCmp = "Error:++Cmp": GoTo Fin
'
'Obtiene el campo
If Idx <> 0 Then
POS2 = POSi(Cmp)
If Cmp = 1 Then
POS1 = 1
POS2 = POSi(Cmp) - 1
Else
' Ultimo
If Cmp = 64 Then Cmp = Idx + 1
If Cmp = Idx + 1 Then
POS1 = POSi(Cmp - 1) + 1
POS2 = Len(Celda) + 1
' Cualquier posición
Else
POS1 = POSi(Cmp - 1) + 1
POS2 = POSi(Cmp) - 1
End If
End If
ExtCmp = Mid$(Celda, POS1, POS2 - POS1 + 1)
Exit Function
Else
ExtCmp = Celda
End If
Fin:
End Function
-
seguramente el código se puede reducir y mejorar pero lo haré cuando
tenga más tiempo.

Saludos

Hola jose luis,

Creo que a partir de Office2000 tu funcion se puede reducir +/- de la siguiente manera:

Function ExtCmp(Celda As String, iSepCmp As String, Cmp As Integer) As String
If Cmp > UBound(Split(Celda, iSepCmp)) + 1 Then ExtCmp = "" _
Else: ExtCmp = Split(Celda, iSepCmp)(Cmp - 1)
End Function

Saludos,
KL


"zipzap" wrote in message news:
Hola Jose
Tengo una función en VBA que permite indicar cualquier caracter como
"Separador de Campo" lo que permite extraer cualquier campo de una
cadena de caracteres. Con alguna pequeña modificación podría hacer
alguna cosa más.
Pej. si la cadena es AAAB.CCCCH.AKL si le indicas que el separador
es "A" y que te extraiga el campo 4, te devolvería B.CCCCH. si le
indicas que el separador es "." al extraer el campo 1 sería AAAB.

Si la quieres, el código es
-
Function ExtCmp(Celda As String, iSepCmp As String, Cmp As Integer) As
String
' Extrae una cadena de otra cadena que esté comprendida entre dos
identificadores
' Celda = Referencia de la celda
' iSepCmp = Caracter identificador de separación
' Cmp = Nº de Campo a extraer (Nº máximo de campos, 64)
'--
Dim POSi(64) As Long
Dim Idx As Integer
Dim NCar As Integer
Dim POS1, POS2 As Long
PalabrasClaveF = "F,FINAL,U,ULTIMO,"
PalabrasClaveP = "P,PRIMERO,PRIMER,INICIO,I,INICIAL,"
Cmp = UCase$(Cmp)
If Val(Cmp) = 0 Then
' If Cmp = "F" Or Cmp = "FINAL" Or Cmp = "U" Or Cmp = "ULTIMO" Then
' Cmp = "U"
' Else
' If Cmp = "P" Or Cmp = "PRIMER" Or Cmp = "PRIMERO" Or Cmp = "I"
Or Cmp = "INICIO" Or Cmp = "INICIAL" Then
' Cmp = "P"
' End If
' End If
If InStr(1, PalabrasClaveF, Cmp & ",") <> 0 Then
Cmp = "U"
Else
If InStr(1, PalabrasClaveP, Cmp & ",") <> 0 Then
Cmp = "P"
Else
Cmp = 0
End If
End If
Else
If Cmp > 64 Then ExtCmp = "Error:++Cmp": GoTo Fin
If Cmp < 1 Then ExtCmp = "Error:--Cmp": GoTo Fin
End If
For i = 1 To 64: POSi(i) = Len(Celda): Next i

'Cuenta Caracteres Separadores
NCar = 1: Idx = 0: POSi(1) = 1
While NCar <= Len(Celda)
If Mid$(Celda, NCar, 1) = iSepCmp Then
Idx = Idx + 1
POSi(Idx) = NCar
End If
NCar = NCar + 1
Wend
'Idx queda definido como número de campos
If Cmp = "P" Then Cmp = 1
If Cmp = "U" Then Cmp = Idx + 1
If Cmp > Idx + 1 Then ExtCmp = "Error:++Cmp": GoTo Fin
'
'Obtiene el campo
If Idx <> 0 Then
POS2 = POSi(Cmp)
If Cmp = 1 Then
POS1 = 1
POS2 = POSi(Cmp) - 1
Else
' Ultimo
If Cmp = 64 Then Cmp = Idx + 1
If Cmp = Idx + 1 Then
POS1 = POSi(Cmp - 1) + 1
POS2 = Len(Celda) + 1
' Cualquier posición
Else
POS1 = POSi(Cmp - 1) + 1
POS2 = POSi(Cmp) - 1
End If
End If
ExtCmp = Mid$(Celda, POS1, POS2 - POS1 + 1)
Exit Function
Else
ExtCmp = Celda
End If
Fin:
End Function
-
seguramente el código se puede reducir y mejorar pero lo haré cuando
tenga más tiempo.

Saludos