Saltar al contenido

Macro para dividir cadenas en dos columnas con delimitador

publicado

Hola a todos, como estan? estoy con un problema que me viene trabando hace dias!!!! y no le encuentro solucion...estoy desesperada...

Tengo un archivo con varios formularios, para una ong que estoy ayudando de cuidado ambiental... 

uno de los formularios en el archivo "FotosOVideosPorCarpeta, permite seleccionar atraves de un boton una carpeta, y obtener en la Hoja13 o " FotosEtiquetadas" todos los datos de los archivos que estan ahi contenidos, como ser tipo de archivo nombre, tamaño etc, pero tambien extrae la informacion de otros atributos que se suele llamar informacion exif de esas fotos, que se añaden como keywords o etiquetas... hasta ahi estamos super... y me coloca esta informacion en la hoja 13.

 

Ahora el detalle de lo que necesito lograr es que :

1) que la columna "B" de la Hoja13 se divida en las columnas subsiguientes por el delimitador "_"  cada vez que se cargue una carpeta nueva, 

2) que la columna "K" que contiene los Tag, keywords o etiquetas tambien se divida en las columnas subsiguientes a traves del delimitador ";" el detalle es que cada etiqueta contiene ademas al comienzo "el nombre de la etiqueta seguido por | " ejemplo:    A.Sitio|San jorge; B.Estacion|Papio; C.Especie|Pecari tajacu y 

en este ejemplo molesta o no sirve "A.Sitio|" deberia quedar solo =  "San jorge" ; no sirve "B.Estacion|" , deberia quedar = Papio; no sirve "C.Especie|" deberia quedar Pecari tajacu ... esto ultimo no se si es posible o no... de no serlo, bueno quedará estorbando... pero al fin lo que necesito es poder separar esa informacion cada vez que se cargue una nueva carpeta sin que se vuelva super lento.

 

Probe con la grabadora de campos  : pero se me vuelve super lento y no siempre me lo ejecuta, 

Este codigo esta en el modulo 12

 

Hoja5.Select
'
   ' Range("B2:B").Select
   ' Selection.TextToColumns Destination:=Range("B2"), DataType:=xlDelimited, _
    '    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    '    Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
     '   :="_", FieldInfo:=Array(Array(1, 1), Array(2, 4), Array(3, 1), Array(4, 1), Array(5, _
     '   1)), TrailingMinusNumbers:=True
        
 'End With

 

 

Luego tambien probe con este codigo:

 

Sub DivisionNombreArchivo(miRango As Range)

Hoja13.Select


Dim celda As Range
Dim matrizresultados() As String
Dim i As Long

For Each celda In miRango
    Range(celda.Offset(0, 1), celda.Offset(0, 5)).ClearContents
    matrizresultados = Split(celda.Value, "_")
    For i = 0 To UBound(matrizresultados)
    celda.Offset(0, i + 1).Value = Trim(matrizresultados(i))
   
    Next i
     
Next celda
End Sub

///  

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 And Target.Row >= 2 Then
Call Módulo12.DivisionNombreArchivo(Target)
End If

End Sub

 

// 

Y tampoco me funciona, lo probe cambiar al evento selection_change y ahi si funciona, pero para que se ejecute tengo que pararme manualmente en cada celda , darle enter y ahi si hace la division... pero no es nada automatizado aunque es mas rapido si...

ambos codigos estan el modulo 12 , y me estan enloqueciendo... me podrian ayudar por favor?

Millones de gracias

Adjunto  el archivo excel quise subir las fotos y no me deja por el tamaño no se como ponerlas: pero por las dudas asi me sale la informacion en la hoja excel:

 

Alcostado_05102022_1345_IMG_0017.mp4     31/5/2022 17:00 12,3 MB   Vídeo  
IASA31-03-22.txt       31/5/2022 15:41 71,4 KB   Texto  
Melanica_22-05-09_00.06_IMG_0023.jpg     31/5/2022 17:00 661 KB   Imagen A.Sitio|San jorge; B.Estacion|Melanica; C.Especie|Tapirus terrestris; D.Observaciones|2 ind.
Papio_22-05-05_12.52_IMG_0569.jpg     31/5/2022 17:00 3,35 MB   Imagen A.Sitio|San jorge; B.Estacion|Papio; C.Especie|Pecari tajacu

Saludos Romi

adjunto el 

Pruebas.xlsm

Featured Replies

publicado
  • Autor
Hace 13 horas, roa30 dijo:

Hola a todos, como estan? estoy con un problema que me viene trabando hace dias!!!! y no le encuentro solucion...estoy desesperada...

Tengo un archivo con varios formularios, para una ong que estoy ayudando de cuidado ambiental... 

uno de los formularios en el archivo "FotosOVideosPorCarpeta, permite seleccionar atraves de un boton una carpeta, y obtener en la Hoja13 o " FotosEtiquetadas" todos los datos de los archivos que estan ahi contenidos, como ser tipo de archivo nombre, tamaño etc, pero tambien extrae la informacion de otros atributos que se suele llamar informacion exif de esas fotos, que se añaden como keywords o etiquetas... hasta ahi estamos super... y me coloca esta informacion en la hoja 13.

Ahora el detalle de lo que necesito lograr es que :

1) que la columna "B" de la Hoja13 se divida en las columnas subsiguientes por el delimitador "_"  cada vez que se cargue una carpeta nueva, 

2) que la columna "K" que contiene los Tag, keywords o etiquetas tambien se divida en las columnas subsiguientes a traves del delimitador ";" el detalle es que cada etiqueta contiene ademas al comienzo "el nombre de la etiqueta seguido por | " ejemplo:    A.Sitio|San jorge; B.Estacion|Papio; C.Especie|Pecari tajacu y 

en este ejemplo molesta o no sirve "A.Sitio|" deberia quedar solo =  "San jorge" ; no sirve "B.Estacion|" , deberia quedar = Papio; no sirve "C.Especie|" deberia quedar Pecari tajacu ... esto ultimo no se si es posible o no... de no serlo, bueno quedará estorbando... pero al fin lo que necesito es poder separar esa informacion cada vez que se cargue una nueva carpeta sin que se vuelva super lento.

Probe con la grabadora de campos  : pero se me vuelve super lento y no siempre me lo ejecuta, 

Este codigo esta en el modulo 12

Hoja13.Select
'
   ' Range("B2:B").Select
   ' Selection.TextToColumns Destination:=Range("B2"), DataType:=xlDelimited, _
    '    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    '    Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
     '   :="_", FieldInfo:=Array(Array(1, 1), Array(2, 4), Array(3, 1), Array(4, 1), Array(5, _
     '   1)), TrailingMinusNumbers:=True
        
 'End With

Luego tambien probe con este codigo:

Sub DivisionNombreArchivo(miRango As Range)

Hoja13.Select
Dim celda As Range
Dim matrizresultados() As String
Dim i As Long

For Each celda In miRango
    Range(celda.Offset(0, 1), celda.Offset(0, 5)).ClearContents
    matrizresultados = Split(celda.Value, "_")
    For i = 0 To UBound(matrizresultados)
    celda.Offset(0, i + 1).Value = Trim(matrizresultados(i))
   
    Next i
     
Next celda
End Sub

///  

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 And Target.Row >= 2 Then
Call Módulo12.DivisionNombreArchivo(Target)
End If

End Sub

 

// 

Y tampoco me funciona, lo probe cambiar al evento selection_change y ahi si funciona, pero para que se ejecute tengo que pararme manualmente en cada celda , darle enter y ahi si hace la division... pero no es nada automatizado aunque es mas rapido si...

ambos codigos estan el modulo 12 , y me estan enloqueciendo... me podrian ayudar por favor?

Millones de gracias

Adjunto  el archivo excel quise subir las fotos y no me deja por el tamaño no se como ponerlas: pero por las dudas asi me sale la informacion en la hoja excel:

 

Alcostado_05102022_1345_IMG_0017.mp4     31/5/2022 17:00 12,3 MB   Vídeo  
IASA31-03-22.txt       31/5/2022 15:41 71,4 KB   Texto  
Melanica_22-05-09_00.06_IMG_0023.jpg     31/5/2022 17:00 661 KB   Imagen A.Sitio|San jorge; B.Estacion|Melanica; C.Especie|Tapirus terrestris; D.Observaciones|2 ind.
Papio_22-05-05_12.52_IMG_0569.jpg     31/5/2022 17:00 3,35 MB   Imagen A.Sitio|San jorge; B.Estacion|Papio; C.Especie|Pecari tajacu

Saludos Romi

adjunto el 

Pruebas.xlsm 1.82 MB · 1 descarga

 

publicado

Te dejo esta UDF para la columna K, con la idea, y por asociación, deberías poder sacar la de la columna B.

Observa las fórmulas de las columnas L:O. 

Function ExtraeDato(Dato As String, Texto As String) As String
On Error Resume Next
If Texto = "" Then Exit Function
datos = Split(Texto, ";")
Select Case Dato
   Case "A": i = 0
   Case "B": i = 1
   Case "C": i = 2
   Case "D": i = 3
End Select
ExtraeDato = Split(datos(i), "|")(1)
End Function

La próxima vez sube un archivo solo con los datos necesarios, en este caso con la hoja FotosEtiquetadas es suficiente.

El almacenamiento de datos no es gratis.

Extraer datos.xlsm

publicado
  • Autor
Hace 1 hora, Antoni dijo:

Te dejo esta UDF para la columna K, con la idea, y por asociación, deberías poder sacar la de la columna B.

Observa las fórmulas de las columnas L:O. 

Function ExtraeDato(Dato As String, Texto As String) As String
On Error Resume Next
If Texto = "" Then Exit Function
datos = Split(Texto, ";")
Select Case Dato
   Case "A": i = 0
   Case "B": i = 1
   Case "C": i = 2
   Case "D": i = 3
End Select
ExtraeDato = Split(datos(i), "|")(1)
End Function

La próxima vez sube un archivo solo con los datos necesarios, en este caso con la hoja FotosEtiquetadas es suficiente.

El almacenamiento de datos no es gratis.

Extraer datos.xlsm 26.59 kB · 2 descargas

Antoni, esta increible la función! eres un gran maestro!

Disculpa por lo del almacenamiento tienes razon! 

Te consulto y de ante mano disculpa mi ignorancia, esas formulas en las columnas L:O deberia ir arrastrando? o la puedo a incorporar a un proceso de carga automatica a la formula cada vez que cargo un registro por un userform?

inserte la funcion en un modulo, probe llamarla y tampoco me ejecuta, tambien estuve intendando asi, use la grabadora de macros y copie la formula que se aplica

    WS.Cells(i, 3).value = "=ExtraeDato(""A"",RC11)"
    WS.Cells(i, 4).value = "=ExtraeDato(""B"",RC11)"
    WS.Cells(i, 5).value = "=ExtraeDato(""C"",RC11)"
    WS.Cells(i, 6).value = "=ExtraeDato(""D"",RC11)"

pero no me hace el split , perdon pero no entiendo como sumar la funcion al formulario ... me podrias guiar por favor?

 

publicado
  • Autor
Hace 5 horas, Antoni dijo:

Te dejo esta UDF para la columna K, con la idea, y por asociación, deberías poder sacar la de la columna B.

Observa las fórmulas de las columnas L:O. 

Function ExtraeDato(Dato As String, Texto As String) As String
On Error Resume Next
If Texto = "" Then Exit Function
datos = Split(Texto, ";")
Select Case Dato
   Case "A": i = 0
   Case "B": i = 1
   Case "C": i = 2
   Case "D": i = 3
End Select
ExtraeDato = Split(datos(i), "|")(1)
End Function

La próxima vez sube un archivo solo con los datos necesarios, en este caso con la hoja FotosEtiquetadas es suficiente.

El almacenamiento de datos no es gratis.

Extraer datos.xlsm 26.59 kB · 5 descargas

Antoni, creo que lo logre ...! no se si de la forma mas optima , pero luego de 3 hs....

  WS.Cells(i, 12).Formula = "=@ExtraeDato(""A"",RC[-1])", 

ahora pruebo aplicarlo al resto! millones de gracias por tu ayuda! siempre agradecida

publicado

Hola

Veo que Antoni, te ha resuelto con VBA, pero como veo que ya que tienes Excel 365, te dejo una alternativa utilizando LET y LAMBDA

En la primera hoja esta la formula solo con LET, en la hoja llamada LAMBDA, elabore una función personalizada, la cual solicitara la celda, un primer separador y otro separador secundario, como además el numero de cadena a extraer, esta ultima opcion con LAMBDA es para los usuarios INSIDER de MSOffice, aun que sin temor a equivocarme, ya estaría disponible para todos

 

Saludos 

Extraer subcadenas LET LAMBDA_GP.xlsx

publicado
  • Autor
En 1/6/2022 at 20:05 , Gerson Pineda dijo:

Hola

Veo que Antoni, te ha resuelto con VBA, pero como veo que ya que tienes Excel 365, te dejo una alternativa utilizando LET y LAMBDA

En la primera hoja esta la formula solo con LET, en la hoja llamada LAMBDA, elabore una función personalizada, la cual solicitara la celda, un primer separador y otro separador secundario, como además el numero de cadena a extraer, esta ultima opcion con LAMBDA es para los usuarios INSIDER de MSOffice, aun que sin temor a equivocarme, ya estaría disponible para todos

 

Saludos 

Extraer subcadenas LET LAMBDA_GP.xlsx 35.79 kB · 3 descargas

Muchas gracias por tu aporte @Gerson Pineda, no sabia que se podia hacer eso ... lo he probado y tambien me funciona super... muchas gracias""

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.

Ir al listado de temas