CONSOLIDAR HOJAS DE UN LIBRO CON UNA CONSULTA SQL DE UNIÓN

Hola a todos:

Hace unos días recibí una consulta acerca de cómo agrupar la información de varias hojas en una hoja específica del mismo libro.

Aunque tengo publicaciones con macros para agrupar información de varios libros,  el método utilizado fue mediante bucles (For – next). Para esta petición utilizaré otro método, trabajaré con ADO y realizaré una consulta de UNION para consolidar la información de las hojas seleccionadas.

Dado que el usuario tendrá siempre la misma estructura en la información de esas hojas y además serán tres, esta macro será perfecta para este trabajo. Con ADO conseguiremos mayor rapidez en la ejecución del código y, si cabe mayor claridad.

Veamos las tres hojas que vamos a consolidar, las llamaré TABLA1, TABLA2 y TABLA3 y la hoja que recibirá toda la información se llamará CONSOLIDADO:

La estructura sería esta:

CONSOLIDAR HOJAS DE UN LIBRO CON UNA CONSULTA SQL DE UNION

Tal como podéis ver, cada una de las tablas tiene la misma estructura que la que muestro arriba. Un ID, Nombre, Estudios, Inglés, Vehículo, Provincia y Edad.

Antes de poner la macro, me gustaría volver a incidir en que es imprescindible que las tablas tengan las mismas columnas con los mismos nombres. Si esto no es así, la macro no funcionará.

Ahora sí, ya podéis pegar el siguiente código en un módulo estándar:

Sub CONSULTA_SQL_UNION()
'Definimos las variables
Dim Dataread As ADODB.Recordset, obSQL As String, Res As String
Dim cnn As ADODB.Connection, i As Integer, MiLibro As String
'Limpiamos hoja que consolida, CONSOLIDADO
Eliminar = Application.CountA(Worksheets("CONSOLIDADO").Range("A:A"))
If Eliminar > 0 Then Worksheets("CONSOLIDADO").Range("A1:GG" & Eliminar).ClearContents
'realizamos consulta SQL de UNION y no tenemos en cuenta los registros nulos
obSQL = "SELECT * FROM [TABLA1$] WHERE NOT [TABLA1$].[ID] IS NULL UNION " & _
"SELECT * FROM [TABLA2$] WHERE NOT [TABLA2$].[ID] IS NULL UNION " & _
"SELECT * FROM [TABLA3$] WHERE NOT [TABLA3$].[ID] IS NULL"
'Guardamos el nombre del libro activo
MiLibro = ActiveWorkbook.Name
'Realizamos la conexión ADO
Set cnn = New ADODB.Connection
With cnn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "DATA SOURCE=" & Application.ActiveWorkbook.Path + "\" & MiLibro
.Properties("Extended Properties") = "Excel 8.0"
.Open
End With
'Procedemos a grababar los datos de la consulta
Set Dataread = New ADODB.Recordset
With Dataread
.Source = obSQL
.ActiveConnection = cnn
.CursorLocation = adUseClient
.CursorType = adOpenForwardOnly
.LockType = adLockReadOnly
.Open
End With
Do Until Dataread.EOF
Res = obRes & Dataread.Fields(0).Value & " " & Dataread.Fields(1).Value
Dataread.MoveFirst
'Copiamos los datos a la hoja CONSOLIDADO
With Worksheets("CONSOLIDADO").Select
Worksheets("CONSOLIDADO").Cells(2, 1).CopyFromRecordset Dataread
End With
'Grabamos los nombres de cada encabezado de columna
For i = 0 To Dataread.Fields.Count - 1
If IsDate(Dataread.Fields(i).Name) Then
dfecha = CDate(Dataread.Fields(i).Name)
Else
dfecha = Dataread.Fields(i).Name
End If
Worksheets("CONSOLIDADO").Cells(1, i + 1) = dfecha
Next
Loop
End Sub

Antes de ejecutar el código debéis verificar que tenéis la referencia: Microsoft ActiveX Data Object 2.8 Library. En este archivo no es necesario que la marquéis (ya la he marcado yo), pero si pegáis el códido en un libro nuevo, sí que la tendréis que marcar.

exportar-una-tabla-o-consulta-de-access-a-excel-con-ado2

El resultado de aplicar la macro es el siguiente:

CONSOLIDAR HOJAS DE UN LIBRO CON UNA CONSULTA SQL DE UNION1

Y ya tenemos los registros de las hojas especificadas en la hoja CONSOLIDADO. En este código si existen duplicados, es decir dos filas o más idénticas, importará solo uno, y también si existen elementos nulos (null) no los tendrá en cuenta. Si queremos que tuviese en cuenta los duplicados, es decir, que los importase, debemos poner “ALL” después de UNION, de esta forma estaremos especificando que unimos todo (incluidos duplicados):

obSQL = "SELECT * FROM [TABLA1$] WHERE NOT [TABLA1$].[ID] IS NULL UNION ALL " & _ "SELECT * FROM [TABLA2$] WHERE NOT [TABLA2$].[ID] IS NULL UNION ALL " & _
"SELECT * FROM [TABLA3$] WHERE NOT [TABLA3$].[ID] IS NULL"

Obviamente, sobre los nulos, no vamos a querer que se cuelen filas en blanco o con caracteres extraños, por eso resulta imprescindible incluir en la sentencia el famoso Not Is Null 🙂

Y esto ha sido todo, os dejo el archivo de ejemplo:

Descarga el archivo de ejemplo pulsando en: CONSOLIDAR HOJAS DE UN LIBRO CON UNA CONSULTA SQL DE UNIÓN

 

Anuncios

EXPORTAR INFORME DE TABLA DINÁMICA EN LA MISMA HOJA

Hola todos 😉

Hoy me gustaría ampliar parte de un post anterior: EXPORTAR INFORME DE TABLA DINAMICA A UN LIBRO NUEVO en el que mediante una macro generábamos automáticamente informes de tabla dinámica y exportábamos cada uno de ellos a un nuevo libro.

Hace unos días un lector quería saber qué modificaciones tenía que hacer en la macro para que esos informes no se generasen en un libro nuevo, sino que se generasen en la misma hoja, uno por pestaña.

Lo cierto, es que la modificación no es compleja, solo hemos de eliminar de la macro anterior toda referencia a “nuevo libro” y dejar que los informes se generen automáticamente en la hoja.

Voy a utilizar un ejemplo nuevo para ilustrar el ejercicio, en este caso, volvemos a los datos por provincias y por número de personas en determinados años. Esta sería la información principal, que la tenemos en una hoja denominada “DATOS”:

EXPORTAR INFORME DE TABLA DINAMICA EN LA MISMA HOJA.jpg

El siguiente paso es insertar una tabla dinámica y en la pestaña Diseño aplicar “mostrar en forma de esquema”, de esta forma aparecerá el título del primer campo seleccionado, en nuestro caso: “Provincia”

EXPORTAR INFORME DE TABLA DINAMICA EN LA MISMA HOJA1

Una vez que tenemos la tabla creada, procedemos escribir nuestro código:

Sub GENERAR_INFORMES_TABLA()
Dim i As Integer
Dim Ini As Integer
Dim Fin As Integer
'Desactivamos actualización de pantalla
Application.ScreenUpdating = False
Sheets("TABLA").Select
With Sheets("TABLA")
'indicamos la fila siguiente a la primera fila con datos: 01 Araba/Álava
Ini = Columns(1).Range("A1").End(xlDown).Row
'Contamos los todas las provincias de la tabla dinámica1, es decir las 52
Fin = .PivotTables(1).PivotFields("PROVINCIA").VisibleItems.Count
'Inciamos un bucle donde por cada provincia generamos informe (ShowDetail)
For i = 1 To Fin
'para mostrar el informe debemos hacer referencia al campo de valor de la tabla
.Cells(i + Ini, 2).ShowDetail = True
'Nombramos la pestaña con el nombre de la provincia.
ActiveSheet.Name = Application.WorksheetFunction.Substitute((.Cells(i + Ini, 1).Value), "/", "_")
Next i
End With
Application.ScreenUpdating = True
End Sub

Lo que vamos a conseguir con esta macro es generar tantos informes como ítems tengamos en la tabla dinámica y los colocaremos en una pestaña cada uno. Dado que estamos nombrando las pestañas de las hojas, debemos tener en cuenta:

– El nombre de la hoja no puede superar los 31 caracteres.
– No ha de contener los siguientes caracteres: \  / ¿ ? * [  ]
– No puede quedar el nombre en blanco.

Seguro que os habéis fijado que en nuestros datos tenemos uno de esos símbolos “/”: por ejemplo en 01 Araba/Álava. Para solucionar este problema sin tener que modificar los datos, realizaremos el cambio en el mismo momento que nombramos la hoja, simplemente sustituyendo “/” por “_” (por ejemplo). Esta es la línea del código en la que hacemos este reemplazo:

ActiveSheet.Name = Application.WorksheetFunction.Substitute((.Cells(i + Ini, 1).Value), "/", "_")

Por supuesto, también podríamos utilizar la función Mid () si necesitásemos extraer los 31 caracteres de la hoja y la función Trim() para eliminar los espacios en blanco.

Una vez aplicada la macro, el resultado sería el siguiente:

EXPORTAR INFORME DE TABLA DINAMICA EN LA MISMA HOJA2.jpg

Y ya tenemos una pestaña por provincia con el informe correspondiente.

Y estos ha sido todo, espero que os sea de utilidad:

Descarga el archivo de ejemplo pulsando en: EXPORTAR INFORME DE TABLA DINÁMICA EN LA MISMA HOJA

 

 

GENERAR ORGANIGRAMA JERÁRQUICO POR ÁREAS CON SMARTART

Hola  todos. ¿Qué tal estáis? 🙂 espero que bien!

En esta web ya llevo varios post dedicados al mundo de SmartArt en Excel, pero complementándolo con VBA. SmartArt ofrece un sensacional efecto visual y un acabado muy profesional en nuestro trabajos. Existen multitud de gráficos y cada uno tiene unas especificaciones concretas en cuanto a utilidad y fin, y eso también se aplica a VBA a la hora de programar un gráfico concreto.

Podréis ver varios ejemplos si escribís en el el buscador de la web la palabra SmartArt, tanto para generar organigramas de varios tipos, como árboles de decisión o estructuras de procesos.

Hoy quiero dedicar un post a un tipo concreto de gráfico de jerarquía, que se denomina en SmartArt como “Jerarquía de tabla”, lo podéis ver en la ficha:

generar-organigrama-jerarquico-por-areas-con-smartart4

Para realizar un ejemplo, he rescatado unos datos usados en uno de los últimos post dedicados a este tema:

generar-organigrama-jerarquico-por-areas-con-smartart2

 

Tenemos la distribución por áreas de una empresa, y necesitamos crear un gráfico que nos muestre un organigrama, empezando por las últimas áreas en la jerarquía hasta la última (Gerencia). No queremos nombres de personas, solo áreas y que se visualicen en bloques.

Para hacerlo vamos a utilizar el siguiente código:

Sub JERARQUIA_POR_AREAS()
'Declaramos variables
Dim Diseño As SmartArtLayout
Dim Shape As Excel.Shape
Dim oNodos As SmartArtNodes
Dim i As Integer, Fin As Integer
With Sheets("ESTRUCTURA")
.Select
'Eliminamos TODOS objetos en la hoja "ESTRUCTURA"
For Each Shape In .Shapes
Shape.Delete
Next
'Insertamos objeto SmartArt, en este caso "Jerarquía de tabla"
Set Diseño = Application.SmartArtLayouts("urn:microsoft.com/office/officeart/2005/8/layout/hierarchy4")
Set inserta = .Shapes.AddSmartArt(Diseño)
Set oNodos = inserta.SmartArt.AllNodes
'Verificamos número de nodos necesarios contando los ítems de la página "DATOS"
Fin = Application.CountA(Sheets("DATOS").Range("A:A"))
'Creamos nodos
Do While oNodos.Count < Fin
oNodos.Add.Promote
Loop
'Eliminamos nodos sobrantes y los nombramos con la información de la hoja "DATOS"
For i = 2 To Fin
Do While oNodos(i - 1).Level < Sheets("DATOS").Range("B" & i).Value
oNodos(i - 1).Demote
Loop
With oNodos(i - 1)
.TextFrame2.TextRange.Text = Sheets("DATOS").Range("A" & i)
End With
Next
'Eliminamos último nodo (estará vacío al tener encabezado la hoja "DATOS")
oNodos(Fin).Delete
'aplicamos estilos
For Each Shape In .Shapes
'Colores
Shape.SmartArt.Color = Application.SmartArtColors("urn:microsoft.com/office/officeart/2005/8/colors/accent2_1")
'Estilos rápidos
Shape.SmartArt.QuickStyle = Application.SmartArtQuickStyles("urn:microsoft.com/office/officeart/2005/8/quickstyle/simple2")
'Dimensionamos la imagen
With .Shapes(1)
.Height = 581.25 'Alto del objeto
.Width = 1375.5 'Ancho del objeto
.Top = 6.749921 ' Altura en la hoja
.Left = 14.25 ' A la izquierda de la hoja
End With
Next
End With
End Sub

El resultado es el siguiente:

generar-organigrama-jerarquico-por-areas-con-smartart1

Como podéis apreciar, obtenemos el efecto deseado, para este ejemplo he utilizado un estilo rápido y colores específicos, pero podéis indicar los que más os gusten, por ejemplo, con colores por cada unidad jerárquica:

generar-organigrama-jerarquico-por-areas-con-smartart3

Para obtener los ID y los nombres, podéis visitar este post: OBTENER NOMBRE E ID DE LOS DISEÑOS, COLORES Y ESTILOS RÁPIDOS DE SMARTART PARA VBA 

Otro consejo 🙂 para este ejemplo estoy utilizando una pantalla grande, es posible que deseéis cambiar el tamaño del gráfico y la posición, para hacer de una forma eficaz, utilizad la pantalla de “inmediato” de vuestro editor de VBA. Primero configurar manualmente el gráfico en la pantalla del ordenador (el aspecto y tamaño que os gustaría que tuviese) y luego, en la pantalla de inmediato, mediante estos comandos obtendréis el ancho, el largo y posición dentro de la hoja, por ejemplo, la altura que debemos indicar:

generar-organigrama-jerarquico-por-areas-con-smartart5

Y este ha sido el ejercicio de hoy. Espero que con esta macro podáis aplicar un estilo diferente a vuestro proyectos 🙂

Descarga el archivo pulsando en: GENERAR ORGANIGRAMA JERÁRQUICO POR ÁREAS CON SMARTART

 

EXTRAER SALDOS NEGATIVOS Y POSITIVOS EN LOS MOVIMIENTOS DE UNA CUENTA

Hola a todos.

Llevo varios post escritos en los que el tema a tratar son las consultas de los lectores. Creo que esto es muy importante, dado que son casos totalmente reales y seguro que se dan más frecuentemente.

Para el caso de hoy voy a presentar un pequeño proceso que extrae los saldos positivos y negativos de los movimientos de una cuenta contable. Esta consulta me la formuló una lectora, que decía así:

Buenos días:

Tengo una relación de cuentas y movimientos por fechas y necesitaría poner los importes negativos en una columna y los positivos en otra. Y también que aparezca el sumatorio de los saldos al final de cada columna, ¿podrías ayudarme?. Te envío un archivo de prueba.

Muchas gracias.

Para hacernos una idea de los datos, he confeccionado un pequeño ejemplo con datos generados aleatoriamente, estos serían los movimientos, las fechas y el resto de la información:

EXTRAER SALDOS NEGATIVOS Y POSITIVOS EN LOS MOVIMIENTOS DE UNA CUENTA.jpg

Para poder realizar la consulta que nos plantea nuestra compañera existen varios métodos, podemos usar un filtro avanzado (pero en VBA), podemos usar una consulta SQL usando ADO, o podemos usar un bucle que vaya acumulando los datos en la columna específica. Para este ejercicio usaré el tercer método, y en concreto una instrucción For-Next (podríamos utilizar cualquier otra estructura de bucle).

La macro que vamos a utilizar es la siguiente:

Sub extraer_saldos()
'Declaramos las variables a utilizar
Dim i As Integer, n As Integer, contador As Integer
'Desactivamos parpadeo de pantalla
Application.ScreenUpdating = False
'Hacemos referencia a la hoja Datos
With Sheets("DATOS")
'Cuando ejectemos la macro, limpiamos el área seleccionada si contiene información
fin = Application.CountA(.Range("A:A"))
If fin > 1 Then .Range("F2:I" & fin, "K2:N" & fin).Clear
'Si no marcamos el mes,lanzamos un mensaje de advertencia y paramos salimos del proceso
nMes = .Cells(2, 16).Value
If nMes = vbNullString Then
MsgBox ("INDICA EL MES (EN NÚMERO) PARA EXTRAER LA INFORMACIÓN"), vbExclamation
Exit Sub
End If
'iniciamos el bucle para pasar los datos con signo negativo a las columnas especificadas
n = 2
For i = 2 To fin
contador = 0
If .Cells(i, 4) < 0 And Month(.Cells(i, 2)) = nMes Then contador = contador + 1
If contador = 1 Then
.Range("F" & n) = .Cells(i, 1).Value
.Range("G" & n) = .Cells(i, 2).Value
.Range("H" & n) = .Cells(i, 3).Value
.Range("I" & n) = .Cells(i, 4).Value
n = n + 1
End If
Next i
'realizamos el sumatorio en la última celda de los importes negativos
RngNeg = Application.CountA(.Range("F:F"))
.Cells(RngNeg + 1, 9) = Application.WorksheetFunction.Sum(.Range("I2:I" & RngNeg))
With .Cells(RngNeg + 1, 9)
.Font.Bold = True
.Style = "Currency"
End With
'iniciamos el bucle para pasar los datos con signo positivo a las columnas especificadas
n = 2
For i = 2 To fin
contador = 0

If .Cells(i, 4) > 0 And Month(.Cells(i, 2)) = nMes Then contador = contador + 1
If contador = 1 Then
.Range("K" & n) = .Cells(i, 1).Value
.Range("L" & n) = .Cells(i, 2).Value
.Range("M" & n) = .Cells(i, 3).Value
.Range("N" & n) = .Cells(i, 4).Value
n = n + 1
End If
Next i
'realizamos el sumatorio en la última celda de los importes negativos
RngNeg = Application.CountA(.Range("K:K"))
.Cells(RngNeg + 1, 14) = Application.WorksheetFunction.Sum(.Range("N2:N" & RngNeg))
With .Cells(RngNeg + 1, 14)
.Font.Bold = True
.Style = "Currency"
End With
End With
Application.ScreenUpdating = True
End Sub

Cuando ejecutamos la macro, el resultado que obtener es el siguiente:

extraer-saldos-negativos-y-positivos-en-los-movimientos-de-una-cuenta1

Como podéis observar, hemos extraído los movimientos positivos y negativos del mes de febrero y realizado el sumatorio en cada columna para obtener el saldo final.

En este caso específico, la lectora solicitaba filtrar bajo el criterio del mes, pero podríamos realizar el filtro en base a la cuenta, el cliente, etc. Es en la macro donde podréis especificar nuevos condicionales que se adapten a vuestras necesidades.

Es un proceso simple y con muchas posibilidades, os animo a ir examinando el código poco a poco y, si es necesario, lo vayáis adaptando a vuestros trabajos.

Descarga el archivo pulsando en: EXTRAER SALDOS NEGATIVOS Y POSITIVOS EN LOS MOVIMIENTOS DE UNA CUENTA

 

CALCULAR DÍAS, MESES Y AÑOS ENTRE DOS FECHAS Y DIFERENTES PERIODOS

Hola a todos!!

Hace unos días recibí una consulta sobre el cálculo de días, meses y años entre dos fechas, pero aplicado a varios periodos, es decir, el obtener los días, los meses y los años entre dos fechas es sencillo cuando aplicamos la función SIFECHA(), podéis profundizar un poco más en este post: CALCULAR AÑOS ENTRE DOS FECHAS EN EXCEL.

Es aplicar la función sifecha() para obtener los días, los meses y los años entre las dos fechas, y donde los elementos se relacionan entre sí, es decir, no son datos absolutos, sino que los meses van acumulando los días y los años van acumulando los meses, este sería un ejemplo:

calcular-dias-meses-y-anos-entre-dos-fechas-y-diferentes-periodos

Las fórmulas usadas para obtener este resultado con:

Años: =SIFECHA(A2;B2; "Y")
Meses: =SIFECHA(A2;B2; "YM")
Días:=SIFECHA(A2;B2; "MD")
Antigüedad General: =SIFECHA(A2;B2; "y")& " años  " & SIFECHA(A2;B2; "ym")& " meses  " &SIFECHA(A2;B2; "md")& " dias "

Hasta ahora esto es sencillo, pero ¿cómo hacemos para calcular el sumatorio de los años, los meses y los días? teniendo muy en cuenta que no podemos sumar simplemente, dado que los días no pueden ser más que los días que tiene un mes.

Lo que estamos buscando sería esto (siguiendo nuestro ejemplo):

calcular-dias-meses-y-anos-entre-dos-fechas-y-diferentes-periodos2

Como podéis observar, el resultado no es la simple suma de conceptos por columna, sino que existe una relación entre días, meses y años, de forma que los días sobrantes se van trasladando a los meses y los meses sobrantes se van trasladando a los años (en este la suma de los periodos no llegan a un año).

Para conseguir este resultado vamos a introducir la siguiente fórmula:

Para los días:
=SI(SUMA($E$2:E5)>30,5;SUMA($E$2:E5)-(ENTERO(SUMA($E$2:E5)/30,5)) *(30,5);SUMA($E$2:E5))

Para los meses:
=SI(SUMA($D$2:D5)+((SUMA($E$2:E5)-E6)/30,5)>11;((SUMA($D$2:D5)+((SUMA($E$2:E5)-E6)/30,5))-(ENTERO((SUMA($D$2:D5)+((SUMA($E$2:E5)-E6)/30,5))/12))*12);SUMA($D$2:D5)+((SUMA($E$2:E5)-E6)/30,5))

Para los años:
=SUMA($C$2:C5) +ENTERO((SUMA($D$2:D5) +((SUMA($E$2:E5)-E6)/12)-D6)/12)

Esta fórmula es bastante conocida en manuales, foros, etc… y me ha parecido interesante dejarla en la web. He realizado algún ajuste que creía interesante para reducir el contenido de la fórmula.

Descarga el archivo pulsando en: CALCULAR DÍAS, MESES Y AÑOS ENTRE DOS FECHAS Y DIFERENTES PERIODOS

EXTRAER INFORMACIÓN ESPECÍFICA DE UNA CADENA DE DATOS

Hace un par de días recibí una consulta sobre un tema que había tratado en un post anterior: EXTRAER NÚMEROS Y TEXTO DE UNA CADENA DE DATOS ALFANUMÉRICA en el que realizaba un pequeño proceso para extraer todos los elementos numéricos y alfabéticos contenidos en una cadena alfanumérica.

Pues bien, un lector me envío la siguiente consulta que reproduzco literalmente:

“Esta macro funciona perfecto, pero quisiera saber si se puede adecuar para que extraiga los datos numéricos de estén definidos con el símbolo $
Ejemplo: tengo un texto de la siguiente forma ADFR45FGF$4510ASD3 Solo se necesita que la formula extraiga el valor de $4510 y que no tenga en cuenta los demás datos numéricos ni alfabéticos.”

Así pues, lo que necesitamos es una macro que sea capaz de extraer determinada información dentro de una cadena de texto:  en este caso el símbolo “$” y los siguientes caracteres numéricos consecutivos, y en caso de ser una letra (u otro caracter no numérico), simplemente no extraer nada.

Para realizar este trabajo debemos pensar y echar mano de funciones como “hallar” para determinar en el lugar de la cadena en el que se encuentra “$”, o lo que es lo mismo, en VBA la función “Search”. Una vez que tenemos este dato, resulta sencillo generar un código que permita extraer los datos hasta llegar al dólar y condicionando a que lo que extraemos sea numérico.

El último paso es invertir los datos extraídos, y ya tenemos la información.

Os dejo aquí la función ya comentada en cada uno de los pasos:

Function extrae_cadena(Micelda As String)
Dim numeros As String, i As Integer, j As Integer
Dim largo As String
'contamos hasta el $
dolar = Application.WorksheetFunction.Search("$", Micelda)
'extraemos los datos desde el dolar en adelante
largo = Trim(Mid(Micelda, dolar, 1000))
'iniciamos bucle para extraer los caracteres de la cadena anterior
fin = Len(largo)
For i = fin To 1 Step -1
'si es $ o número lo extraemos, pero si es letra no extraemos
If (Mid(largo, i, 1)) = "$" Or IsNumeric((Mid(largo, i, 1))) Then
numeros = numeros & Mid(largo, i, 1)
Else
numeros = ""
End If
Next
'invertimos el orden de los datos con otro bucle secundario
sCadena = Len(numeros)
For j = 1 To sCadena
Resultado = Mid(numeros, j, 1) & Resultado
Next j
'y ya tenemos la información
extrae_cadena = Resultado
End Function

Con esta función ya podemos extraer los datos de forma directa, tecleando en una celada la función “extrae_cadena()” y seleccionando la celda que contiene los datos.

extraer-informacion-especifica-de-una-cadena-de-datos1

También lo podéis automatizar con una macro, para darle al botón y que se extraigan los datos en la columna “B”:

Sub extrae_num()
'Ejecutamos proceso que recorre todos los datos
Dim c As Integer
With Sheets(1)
fin = Application.CountA(.Range("A:A"))
For c = 2 To fin
'Aplicamos formato texto a las celdas de la columna 2
.Cells(c, 2).NumberFormat = "@"
'aplicamos funcion extrae_cadena e insertamos resultado
.Cells(c, 2) = extrae_cadena(.Cells(c, 1))
Next
End With
End Sub

En ambos casos el resultado será el mismo, es decir extraeremos la información según los datos que nos han solicitado:

extraer-informacion-especifica-de-una-cadena-de-datos2

Y he dejado la primera celda con los datos de la consulta del lector. El resultado es el solicitado: $4510

Es un pequeño ejemplo, pero os puede ser de utilidad, dado que aquí aunque usamos el $, se puede usar cualquier otro símbolo, numero o parámetro.

Os dejo como siempre el ejemplo:

Descarga el archivo pulsando en: EXTRAER INFORMACIÓN ESPECÍFICA DE UNA CADENA DE DATOS

 

SEGMENTAR EL CONTENIDO DE UNA CELDA

Hola a todos 🙂

Qué tal estáis?, espero que bien!. Esta semana he tenido varias consultas, algunas han sido bastante complejas y otras interesante por lo extraño de lo que me pedían. Una de ellas es el motivo de este post.

Y como digo en el título, lo que me pedían era poder segmentar una serie de contenidos (numéricos) de varias celdas e ir colocando cada uno de los números en la siguiente celda, por ejemplo imaginad que tenéis en una celda la siguiente cifra:
“10000” y se pide segmentar este número (incluidos los ceros) en las siguientes celdas a la derecha, es decir:

segmentar-el-contenido-de-una-celda

Aunque desconozco la finalidad de este trabajo y no logro identificar su utilidad, está claro que para ese lector sí era importante. Así que desarrollé un pequeño proceso para automatizarlo. Esta es la macro:

Sub SEGMENTAR()
'Definimos variables
Dim i As Integer, j As Integer, n As Integer
Dim sDat As String, fin As Double
With Sheets("SEGMENTAR")
'contamos el rango de los contenidos a segmentar
fin = Application.CountA(.Range("A:A"))
'iniciamos el primer bucle para seleccionar cada contenido
For n = 2 To fin
'iniciamos un segundo bucle que cuente y extraiga cada parte del contenido de la celda
For i = Len(.Cells(n, 1)) To 1 Step -1
sDat = Mid(.Cells(n, 1), i, 1)
'iniciamos un tercer bucle para colocar el segmento extraido en la celda a la derecha
For j = 1 To i
.Cells(n, j + 1) = sDat
Next j
Next i
Next n
End With
End Sub

Y una vez que aplicamos el código a las celdas de la columna “A”, segmentaremos cada uno de los contenidos.

Este es un ejemplo:

segmentar-el-contenido-de-una-celda1

Lógicamente funciona tanto con datos numéricos como con datos alfanuméricos. En este ejemplo, he tenido que transformar los datos numéricos en texto a partir de la cifra en “A12”, de lo contrario el dato se mostraría en notación científica (a partir de cifras mayores o iguales a 12 dígitos) y no quedaría muy estético (podéis echar un vistazo a los límites de Excel).

Este ha sido el post de hoy y como me ha parecido interesante lo comparto con todos vosotros 🙂

Descarga el archivo pulsando en: SEGMENTAR EL CONTENIDO DE UNA CELDA