Imprimir página | Cerrar ventana

Extraer texto de una celda, con VBA

Impreso de: Foro de Access y VBA
Categoría: Otros de Microsoft: Windows y Office
Nombre del foro: Excel
Descripción del foro: Foro de Excel y VBA de Excel
URL: http://www.mvp-access.com/foro/forum_posts.asp?TID=84328
Fecha de impresión: 22/Mayo/2019 a las 11:02


Tema: Extraer texto de una celda, con VBA
Publicado por: insyse
Asunto: Extraer texto de una celda, con VBA
Fecha de publicación: 26/Febrero/2019 a las 01:28
Hola muchachos... 

Necsito hacer una macro, que voy a usar en un bucle, que me ayude a extraer de una celda, unos digistos que estan entre dos partes recurresntes de la celda. 

Ejemplo...

Este es el contenido de una de las celdas... 

MUNICIPIOS DE CUN (Id: 830,016,820-4 Dir: CALLE 25 D 95-56   BOGOTA Tel: 5878150)

Este es el texto que necesito extraer... 
830,016,820-4

Siempre esta después de (Id:  y antes de Dir: por lo que creo que es la opcion por la cual se puede identificar el texto a extraer. 

El el problema es que las celdas tienen siempre contenidos diferentes de largos diferentes, y el texto a extraer no siempre tiene la misma estructura tampoco, a veces tiene un código al final, otras veces no, como se ve en los siguientes líneas de ejemplo. 

OPERADORES LTDA (Id: 830,060,549-9 Dir: CALLE 116 #60-97 Tel: 5334771)
EMAJAR LTDA (Id: 830,114,244-1 Dir: CALLE 134     46-76  EDS SPRING BOGOTA Tel: 5206523)
EL JARDIN S.A. (Id: 860,071,595-4 Dir: CRA.92 #64C-80 Tel: 4302930)
GOMEZ LUIS EDUARDO (Id: 79,960,939 Dir: CR 102 16 B 16 Tel: 4042218)
ETC... 
ETC... 
ETC...

Son aproximadamente 200 registros, asi que extraerlos de uno en uno es terriblemente largo y debo hacer esto cada semana... 

Si alguien me puede ayudar con un código que me ayude a hacer esta extracción.
Se lo agradeceré muchisimo.. 








Respuestas:
Publicado por: xavi
Fecha de publicación: 26/Febrero/2019 a las 12:29
Hola,

Supongo que buscas algo así:


Function insyse()

    Dim f           As Integer
    Dim strTexto    As String
    f = 1
    Do Until ThisWorkbook.ActiveSheet.Cells(f, 1) = ""
        strTexto = ThisWorkbook.ActiveSheet.Cells(f, 1)
        strTexto = Trim(Mid(strTexto, InStr(1, strTexto, "Id:") + 3))
        strTexto = Trim(Left(strTexto, InStrRev(strTexto, "Dir") - 1))
        ThisWorkbook.ActiveSheet.Cells(f, 2) = strTexto
        f = f + 1
    Loop
    
End Function

Aunque tambien se puede hacer mediante fórmulas.

Un saludo


-------------
Xavi, un minyó de Terrassa

http://www.llodax.com" rel="nofollow - Mi web


Publicado por: xavi
Fecha de publicación: 26/Febrero/2019 a las 12:30
Ah! se me olvidaba...

La función supone datos en la columna A a partir de la primera fila y coloca el resultado en la segunda columna.

Ya sabes: los experimentos, con gaseosa.




-------------
Xavi, un minyó de Terrassa

http://www.llodax.com" rel="nofollow - Mi web


Publicado por: lbauluz
Fecha de publicación: 26/Febrero/2019 a las 14:24
Por fórmulas

1) Asumo para este ejemplo que la cadena está en B3
2) Formulas en inglés

=MID(B3,(SEARCH("Id:", B3)+4),((SEARCH("Dir:", B3))-(SEARCH("Id:", B3)+4)))


Luis


-------------
Those are my principles, and if you don't like them... well, I have others. Groucho Marx


Publicado por: insyse
Fecha de publicación: 27/Febrero/2019 a las 05:50
Estimado Luis, Te agradezco mucho, la formula funciona perfectamente, y la verdad no concia la fornula hallar... 

Muchas gracias !



Imprimir página | Cerrar ventana