REALIZAR VARIAS CONSULTAS SQL CON ADO EN LA MISMA MACRO

Hola a todos!.

¿Qué tal os va?, espero que bien!. Hoy voy tratar el tema de las consultas SQL con ADO, en concreto voy a mostraros un método para poder realizar varias consultas SQL en una única macro.

Voy a partir de un post anterior para realizar el ejercicio: CRUZAR DOS TABLAS EN EXCEL USANDO SQL

En este post, mostraba la forma de realizar un cruce de dos bases de datos mediante consultas SQL usando ADO para obtener, altas, bajas, y movimientos entre los departamentos de unos grandes almacenes.

Si consultais las macros, veréis que hay cuatro en total, una para cada consulta. El motivo de hacerlo de esta forma es para se pueda comprender mejor la forma de usar ADO para quienes lo están empezando a programar y no me gusta complicar en exceso las programaciones dado que muchas veces, lo complicado en lugar de generar curiosidad, genera frustración.

Dicho esto, y una vez publicada la entrada anterior, ya puedo mostrar la forma de hacerlo en una única macro.

El código que vamos a utilizar es similar al ya utilizado, solo que vamos a escribir las cuatro sentencias SQL en el mismo código:

Sub GENERAR_CONSULTA()
Dim Dataread As ADODB.Recordset, obSQL As String
Dim cnn As ADODB.Connection, fin As Integer, milibro As String, i As Long
Dim alta As String, baja As String, alta_seccion As String, baja_seccion As String
Dim consulta As Variant, titulo As String
fin = Application.CountA(Sheets("MOVIMIENTOS").Range("A:A"))
'Borramos datos de consultas anteriores
Sheets("MOVIMIENTOS").Range("A2:D" & fin + 1).Clear
'indicamos los parámetros de las consultas que necesitamos:
'buscamos empleados nuevos
alta = "SELECT [BBDD_ACTUAL$].[ID], [BBDD_ACTUAL$].[NOMBRE COMPLETO], [BBDD_ACTUAL$].[SECCION], 'NUEVO EMPLEADO' AS ESTADO " & _
"FROM [BBDD_ACTUAL$] LEFT JOIN [BBDD_ANTERIOR$] ON [BBDD_ACTUAL$].[ID] = [BBDD_ANTERIOR$].[ID]" & _
"WHERE(([BBDD_ANTERIOR$].[ID]) IS NULL)"
'buscamos empleados que han sido baja
baja = "SELECT [BBDD_ANTERIOR$].[ID], [BBDD_ANTERIOR$].[NOMBRE COMPLETO], [BBDD_ANTERIOR$].[SECCION], 'BAJA' " & _
"FROM [BBDD_ANTERIOR$] LEFT JOIN [BBDD_ACTUAL$] ON [BBDD_ACTUAL$].[ID] = [BBDD_ANTERIOR$].[ID]" & _
"WHERE(([BBDD_ACTUAL$].[ID]) IS NULL)"
'buscamos movimientos de alta en departamento
alta_seccion = "SELECT [BBDD_ACTUAL$].[ID], [BBDD_ACTUAL$].[NOMBRE COMPLETO], [BBDD_ACTUAL$].[SECCION], 'ALTA SECCION' " & _
"FROM [BBDD_ACTUAL$] LEFT JOIN [BBDD_ANTERIOR$] ON [BBDD_ACTUAL$].[ID] = [BBDD_ANTERIOR$].[ID]" & _
"WHERE([BBDD_ACTUAL$].[SECCION]) NOT LIKE [BBDD_ANTERIOR$].[SECCION] "
'buscamos movimientos de baja en departamento
baja_seccion = "SELECT [BBDD_ANTERIOR$].[ID], [BBDD_ANTERIOR$].[NOMBRE COMPLETO], [BBDD_ANTERIOR$].[SECCION], 'BAJA SECCION' " & _
"FROM [BBDD_ACTUAL$] LEFT JOIN [BBDD_ANTERIOR$] ON [BBDD_ACTUAL$].[ID] = [BBDD_ANTERIOR$].[ID]" & _
"WHERE([BBDD_ANTERIOR$].[SECCION]) NOT LIKE [BBDD_ACTUAL$].[SECCION] "
'iniciamos loop por cada consulta SQL
For Each consulta In Array(alta, baja, alta_seccion, baja_seccion)
fin = Application.CountA(Sheets("MOVIMIENTOS").Range("A:A")) + 1
'Obtenemos el nombre del libro
milibro = ThisWorkbook.Name
'Creamos la conexión ADO
Set cnn = New ADODB.Connection
With cnn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "DATA SOURCE=" & Application.ActiveWorkbook.Path + "\" & milibro
.Properties("Extended Properties") = "Excel 8.0"
.Open
End With
Set Dataread = New ADODB.Recordset
With Dataread
.Source = consulta
.ActiveConnection = cnn
.CursorLocation = adUseClient
.CursorType = adOpenForwardOnly
.LockType = adLockReadOnly
.Open
End With
'pasamos información a la hoja movimientos
Do Until Dataread.EOF
Dataread.MoveFirst
With Worksheets("MOVIMIENTOS")
.Cells(fin, 1).CopyFromRecordset Dataread
'Indicamos encabezados
For i = 0 To Dataread.Fields.Count - 1
titulo = Dataread.Fields(i).Name
.Cells(1, i + 1) = titulo
Next
.Cells(1, Dataread.Fields.Count) = "ESTADO"
End With
Loop
'ejecutamos la siguiente consulta
Next consulta
Set Dataread = Nothing
Set cnn = Nothing
End Sub

Como podéis observar, reducimos significativamente el tamaño de nuestro código y lo hacemos más eficiente y compacto. La clave está es crear un loop sobre el que iremos pasando cada una de las consultas SQL. Esto se consigue indicando el nombre de cada consulta en un array:

For Each consulta In Array(alta, baja, alta_seccion, baja_seccion)

El objeto “consulta” contendrá la secuencia SQL de cada consulta, lo que nos va a permitir pasar esos parámetros al recordset:

.Source = consulta

De esta forma en cada ciclo del loop tendremos el resultado de cada consulta, luego solo tenemos que pasar la información a la hoja movimientos y utilizar la variable “fin” para indicar el final de los datos de cada consulta y que se pueda mostrar el resultado en conjunto.

Una vez ejecutada la macro, tenemos el siguiente resultado, el mismo que el post del que estamos haciendo referencia.

REALIZAR VARIAS CONSULTAS SQL EN LA MISMA MACRO CON ADO

Y esto es todo, un método muy sencillo (dentro de la complejidad de ADO), que seguro os ayudará a realizar códigos más reducidos y eficientes.

Descarga el archivo de ejemplo pulsando en: REALIZAR VARIAS CONSULTAS SQL CON ADO EN LA MISMA MACRO

¿Te ha resultado de interés?, puedes apoyar a Excel Signum con una pequeña donación.

Donate Button with Credit Cards

¡¡Muchas gracias!!

Mediante la suscripción al blog, la realización comentarios o el uso del formulario de contacto estás dando tu consentimiento expreso al tratamiento de los datos personales proporcionados según lo dispuesto en la ley vigente (LOPD). Tienes más información al respecto en esta página del blog: Política de Privacidad y Cookies

Anuncios

INTRODUCIR MÚLTIPLES VALORES EN UN INPUTBOX

Hola a todos!.

Qué tal estáis? espero que bien! y supongo que muchos de vosotros ya estáis disfrutando de las vacaciones o esperando a que lleguen.

Hoy voy a comentar una solución que le ofrecí a un lector que me consultaba cómo podría introducir en un inputbox dos o más datos. Normalmente esta tarea se realiza con un formulario o userform, habilitando tantos cuadros de texto como sean necesarios.

Pero en el caso del inputbox solo tenemos un cuadro de texto, sin posibilidad de poder crear más cuadros de texto. Lo que nos obligaría a crear tantos inputbox como datos necesitemos introducir.

Pero existe una solución para poder introducir valores múltiples en un inputbox. Veamos un ejemplo, imaginad que queréis pasar dos fechas (Inicio y Fin) a través del mismo inputbox y mostrar los datos en las siguientes celdas:

INTRODUCIR MÚLTIPLES VALORES EN UN INPUTBOX

Para poder hacerlo, vamos a utilizar el siguiente código que he programado:

Sub INPUT_VARIOS()
'Declaramos las variables
Dim formulario, miarray
'Invocamos inputbox e indicamos las fechas separadas por una coma
formulario = InputBox("INDICA FECHA INICIO Y FECHA FIN SEPARADO POR UNA COMA:" & Chr(13) & Chr(13) & "EJEM: 01/01/2018,01/03/2018", "FECHAS")
'Si no ponemos nada, salimos del proceso
If formulario = Empty Then Exit Sub
'verificamos que los datos introducidos son correctos, si hay errores, los detectamos al final
On Error GoTo etiqueta
'Pasamos las dos fechas a una matriz utilizando la función split
miarray = Split(formulario, ",")
'Pasamos los datos a cada celda igualando los array
With Sheets("Hoja1")
.Cells(2, 1) = CDate(miarray(0))
.Cells(2, 2) = CDate(miarray(1))
End With
Exit Sub
etiqueta:
MsgBox ("Verifica los datos que has introducido e inténtalo de nuevo"), vbExclamation
End Sub

Al ejecutarlo veremos el siguiente inputbox en nuestra hoja:

INTRODUCIR MÚLTIPLES VALORES EN UN INPUTBOX_1

Como podéis observar en la macro, estamos utilizando la función split para pasar la información que hemos indicado en cuadro de texto del inputbox a una matriz. Como necesitamos indicar un elemento o carácter que separe las dos fechas (o cualquier otro dato), he decido utilizar la coma “,”aunque podríamos usar el punto y coma, “;” una arroba “@” etc, sustituyéndolo en la macro:

miarray = Split(formulario, ",")

Una vez que tenemos ambos datos, tan solo tendremos que pasar la información a las celdas de la hoja que necesitamos rellenar y lo hacemos pulsando en el botón aceptar de nuestro inputbox. Como cortesía hacia el lector, he programados varias líneas de código para controlar los datos erróneos o que surjan errores a la hora de ejecutar la macro.

El resultado es que tenemos en las celdas la información indicada en el cuadro de texto:

INTRODUCIR MÚLTIPLES VALORES EN UN INPUTBOX_2

Y eso es todo, como podéis observar sí es posible introducir valores múltiples en un inputbox.

Descarga el archivo de ejemplo pulsando en: INTRODUCIR MÚLTIPLES VALORES EN UN INPUTBOX

¿Te ha resultado de interés?, puedes apoyar a Excel Signum con una pequeña donación.

Donate Button with Credit Cards

¡¡Muchas gracias!!

Mediante la suscripción al blog, la realización comentarios o el uso del formulario de contacto estás dando tu consentimiento expreso al tratamiento de los datos personales proporcionados según lo dispuesto en la ley vigente (LOPD). Tienes más información al respecto en esta página del blog: Política de Privacidad y Cookies

EVITAR PANTALLA EN BLANCO Y MENSAJE “VBA NO RESPONDE” CUANDO EJECUTAMOS UNA RUTINA EN VBA

Hola a todos!

En algunas ocasiones , cuando programamos nuestras rutinas en VBA y el número de loops que realizamos es alto o se subdivide en varios procesos, cuando pulsamos en la nuestra hoja excel o en la pantalla del editor de VBA cuando se está ejecutando el código, se bloquea y se pone totalmente en blanco y muestra el mensaje de que VBA o Excel no responde.

Pero en realidad sí está ejecutando el código solo que no lo vemos, dado que excel muestra ese mensaje como consecuencia de la acumulación de eventos en nuestro procedimiento en ejecución.

Aunque seguro que hay otras formas de hacerlo, os voy a comentar la forma en la que suelo evitar esto cuando es necesario que el usuario o bien, pueda observar cómo se van desarrollando los diferentes pasos de la macro o bien, si no está familiarizado con VBA, no crea que el programa no funciona o no responde.

Hay que tener en cuenta que este mensaje también puede surgir cuando realmente existe un problema con el código (programación deficiente, loops infinitos, etc), para esos casos esta solución no será efectiva).

Voy a utilizar un código con algunos loops de diferente tipo, for – next y do – while los cuales nos van a venir perfectos. El código está en este post publicado sobre smartart: PROGRAMAR SMARTART PARA GENERAR UN DIAGRAMA DE GANTT

Dado que debemos actuar en los loops o bucles, lo que vamos a hacer es forzar a vaciar los eventos que se van acumulando. Esto lo vamos a lograr con esta sencilla línea de código:

If (Variable del loop) Mod (divisor) = 0 Then DoEvents

Aquí podéis profundizar un poco más sobre el operador MOD y su utilidad en este código. Lo utilizamos para condicionar el funcionamiento del método “doevents

Cuando el resultado de MOD, que es el residuo resultante de la división indicada en la condición sea igual a 0 entonces aplicamos doevents.

Esta condición, dependiendo del código, su estructura y variables, será necesario utilizarlo en diferentes parte de la macro. Normalmente en los bucles que resulten más lentos o extensos. Esto lo debéis ir verificando vosotros mismos cuando programéis vuestras rutinas.

En el ejemplo comentado, he incluido en tres ocasiones esta condición, lo resalto en rojo:

Sub DIAGRAMA_GANTT_SMARTART()
'Declaramos variables
Dim Diseño As SmartArtLayout
Dim Shape As Excel.Shape
Dim oNodos As SmartArtNodes
Dim inserta As Shape
Dim i As Integer, Fin As Integer
Dim j As Integer, valor As Double
Dim NPorcent As String, Per_2 As Long, Per_1 As Long
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 Multinivel"
Set Diseño = Application.SmartArtLayouts("urn:microsoft.com/office/officeart/2008/layout/HorizontalMultiLevelHierarchy")
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
'vaciamos eventos
If oNodos.Count Mod 2 = 0 Then DoEvents
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
'vaciamos eventos
If i Mod 2 = 0 Then DoEvents
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")
'Iniciamos loop para recorrer el diagrama desde el último item al primero
For j = Fin To 2 Step -1
'Si el % está vacío, asignamos un valor 0 a la variable valor
If Sheets("DATOS").Range("F" & j).Value = Empty Then
valor = 0
ElseIf Sheets("DATOS").Range("F" & j).Value > 1 Then
valor = 1
Else
valor = Sheets("DATOS").Range("F" & j).Value
End If
'expresamos en color el porcentaje de cumplimiento de objetivos
With oNodos(j - 1).Shapes.Fill
.TwoColorGradient Style:=msoGradientVertical, Variant:=1
.GradientStops(2).Color = vbWhite
.GradientStops(1).Position = valor
.GradientStops(2).Position = valor
.GradientStops(1).Color.RGB = RGB(204, 204, 255)
End With

'Adicionalmente añadimos el porcentaje en número al diagrama y lo coloreamos en azul
With oNodos(j - 1)
.TextFrame2.TextRange.Text = Sheets("DATOS").Range("A" & j) & " " & Format(valor, "Percent")
NPorcent = Sheets("DATOS").Range("A" & j) & " " & Format(valor, "Percent")
Per_1 = UBound(Split(NPorcent)) + 1
Per_2 = UBound(Split(NPorcent)) + 2
.TextFrame2.TextRange.Words(Per_1).Font.Fill.ForeColor.RGB = vbBlue
.TextFrame2.TextRange.Words(Per_2).Font.Fill.ForeColor.RGB = vbBlue
End With
'vaciamos eventos
If j Mod 2 = 0 Then DoEvents
Next j
'Dimensionamos la imagen
With .Shapes(1)
.Height = 581.25 'Alto del objeto
.Width = 600.5 'Ancho del objeto
.Top = 100 ' Altura en la hoja
.Left = 14.25 ' A la izquierda de la hoja
End With
Next
End With
End Sub

El resultado es que además evitar que se congele nuestro proceso y por lo tanto el sistema nos diga que vba no responde, podemos ver cómo se desarrolla la macro en su totalidad.

Os he grabado un breve vídeo de la ejecución de esta macro para que veáis cómo funciona doevents:

Considero que no es necesario que os deje un archivo de prueba, creo que vosotros mismos podréis descargar del post anterior el código e introducir esta condición.

Os animo a realizar esta sencilla tarea para que comprobéis el cambio que se produce.

Y eso es todo, espero que facilite vuestros proyectos en VBA esta solución : )

¿Te ha resultado de interés?, puedes apoyar a Excel Signum con una pequeña donación.

Donate Button with Credit Cards

¡¡Muchas gracias!!

Mediante la suscripción al blog, la realización comentarios o el uso del formulario de contacto estás dando tu consentimiento expreso al tratamiento de los datos personales proporcionados según lo dispuesto en la ley vigente (LOPD). Tienes más información al respecto en esta página del blog: Política de Privacidad y Cookies

LISTAR LAS PROPIEDADES DE TODOS LOS ARCHIVOS DE UNA CARPETA Y SUBCARPETAS

Hola a todos!

Hace varios meses publiqué un post en el que trataba la forma de listar todos los archivos contenidos en una carpeta y subcarpetas: LISTAR TODOS LOS ARCHIVOS DE UNA CARPETA Y SUS SUBCARPETAS CON VBA

Hoy un lector me preguntaba la posibilidad de añadir a esta información la fecha de la última modificación en cada archivo listado. En realidad podemos obtener muchas más propiedades que nos pueden ser de utilidad según el tipo de necesidad que tengamos.

Para obtener lo que nos indica el lector, tan solo vamos a tener que realizar una pequeña modificación en la función original:

Function CARPETA(ByVal nCarpeta)
'Declaramos variables
Dim j As Long, Subcarpeta As Object
With ActiveSheet
'Iniciamos dos loop, uno que recorre las carpetas
For Each Subcarpeta In nCarpeta.SubFolders
CARPETA Subcarpeta
Next
j = Application.CountA(.Range("A:A")) + 1
'y otro que recorre los archivos y extrae propiedades
For Each file In nCarpeta.Files
.Cells(j, 1).Select
'fecha de creación
.Cells(j, 2) = file.DateCreated
'fecha de última modificación
.Cells(j, 3) = file.DateLastModified
'fecha del último acceso
.Cells(j, 4) = file.DateLastAccessed
'tipo de archivo
.Cells(j, 5) = file.Type
'tamaño
.Cells(j, 6) = file.Size
'por último activamos hipervínculo en el path del archivo
.Hyperlinks.Add Anchor:=Selection, Address:=file.Path, TextToDisplay:=file.Path
j = j + 1
Next
End With
End Function

Como podéis observar, utilizando el objeto file con el que anteriormente obtenemos su ruta, también podemos obtener una serie de propiedades, entre ellas la fecha de la última modificación DateLastModified

Pero también otras como el tipo de archivo, su tamaño, la fecha de creación y la del último acceso.

El resultado sería este:

LISTAR LAS PROPIEDADES DE TODOS LOS ARCHIVOS DE UNA CARPETA Y SUBCARPETAS

Así la consulta quedaría contestada y el lector ya tiene toda la información que necesita.

Y esto es todo!

Descarga el archivo de ejemplo pulsando en: LISTAR LAS PROPIEDADES DE TODOS LOS ARCHIVOS DE UNA CARPETA Y SUBCARPETAS

¿Te ha resultado de interés?, puedes apoyar a Excel Signum con una pequeña donación.

Donate Button with Credit Cards

¡¡Muchas gracias!!

Mediante la suscripción al blog, la realización comentarios o el uso del formulario de contacto estás dando tu consentimiento expreso al tratamiento de los datos personales proporcionados según lo dispuesto en la ley vigente (LOPD). Tienes más información al respecto en esta página del blog: Política de Privacidad y Cookies

ROMPER TODOS LOS VÍNCULOS CREADOS EN UN POWERPOINT

Hola a todos:

Aunque esta web trata fundamentalmente sobre Excel, hoy voy a hacer una excepción para tratar un tema recurrente en el mundo de las presentación y los trabajos realizados entre Excel y PowerPoint.

En muchas ocasiones, las presentación que se realizan en PowerPoint utilizan objetos embebidos para mantener las vinculaciones de los datos que se generar desde otros programas, por ejemplo, desde Excel.

Os mostraré un sencillo ejemplo de cómo se realiza esta tarea, imaginad que tenemos este gráfico en una hoja excel:

ROMPER TODOS LOS VINCULOS CREADOS EN UN POWERPOINT

Si queremos que nuestra presentación de PowerPoint contenga este gráfico y se pueda actualizar automáticamente, no basta con cortar en Excel y pegar en Point, es necesario pegar de una forma especial:

ROMPER TODOS LOS VINCULOS CREADOS EN UN POWERPOINT1

Como podéis ver en la imagen, estamos pegando un vinculo con el pegado especial. De esta forma cualquier cambio que se produzca en Excel se reflejará en PPT:

ROMPER TODOS LOS VINCULOS CREADOS EN UN POWERPOINT2

Pero ¿qué sucede cuando queremos enviar esa presentación por correo?, pues que al abrirse en archivo nos va a preguntar si queremos actualizar los vínculos a, en este caso, el archivo de Excel. Para evitar que el usuario al que hemos enviado la presentación tenga que elegir si actualiza o no los vínculos, la única opción que tenemos es romperlos.

Para romper los vínculos a otros archivos en una presentación, tenemos tres opciones:

La primera opción consiste en pulsar en “Archivo” y luego en la opción “Información y buscar en la parte inferior derecha: “Editar vínculos a archivos”:

ROMPER TODOS LOS VINCULOS CREADOS EN UN POWERPOINT3

Una vez que pulsamos en esa opción se mostrará una ventana “vínculos” y solo tendremos que pulsar el botón “romper vínculo” para eliminar todas las vinculaciones a nuestra presentación.

La segunda opción es agregando el botón de “Romper vínculo” a la cinta de opciones. Para eso debemos ir a Archivo > Opciones > Personalizar cinta de Opciones y agregar Romper vínculo. El botón quedaría así:

ROMPER TODOS LOS VINCULOS CREADOS EN UN POWERPOINT4

Esta modalidad permite eliminar los vínculos sobre el objeto que seleccionemos, a diferencia del anterior que elimina todos los vínculos de la presentación.

Por último, os dejo otra forma, esta vez con VBA. Ejecutando este código en un módulo estándar de nuestra presentación eliminará todos los vínculos de la presentación:

Sub Romper_vinculos()
'Declaramos variables
Dim obj As Shape
Dim diapo As Slide
'Primer bucle recorremos todas las diapositivas
For Each diapo In ActivePresentation.Slides
'Segundo bucle recorremos todos los objetos de la diapo
For Each obj In diapo.Shapes
'si se trata de un objeto embebido eliminamos el link
If obj.Type = msoLinkedOLEObject Then
obj.LinkFormat.BreakLink
End If
Next obj
Next diapo
End Sub

Como es obvio, lo lógico es que esto lo hagamos sobre una copia de la presentación original, dado que de otra forma perderíamos las vinculaciones de nuestro trabajo.

Para este post no dejaré archivo dado que no es necesario y la información está dispuesta a modo de tutorial.

Espero que os haya resultado de interés : )

¿Te ha resultado de interés?, puedes apoyar a Excel Signum con una pequeña donación.

Donate Button with Credit Cards

¡¡Muchas gracias!!

Mediante la suscripción al blog, la realización comentarios o el uso del formulario de contacto estás dando tu consentimiento expreso al tratamiento de los datos personales proporcionados según lo dispuesto en la ley vigente (LOPD). Tienes más información al respecto en esta página del blog: Política de Privacidad y Cookies

SUMAR LA PARTE DECIMAL DEL CONTENIDO DE UN RANGO NUMÉRICO

Hola a todos!

Ayer tratábamos la forma de extraer  la parte entera de un número para realizar un sumatorio en un rango: SUMAR LA PARTE ENTERA DEL CONTENIDO DE UN RANGO CON NÚMEROS DECIMALES

Y tal como os comentaba, en la publicación de hoy me gustaría tratar la otra consulta que me habían enviado y que se refiere a la posibilidad de extraer la parte decimal de un número y proceder a su sumatorio, teniendo en cuenta también si es o no negativo.

Bien, para realizar esto os propongo crear una UDF (función definida por el usuario) que solucionará nuestro problema, veamos el ejemplo:

SUMAR LA PARTE DECIMAL DEL CONTENIDO DE UN RANGO NUMÉRICO

En la columna DATOS tenemos el número completo y en columna B la parte decimal (respetando si el número es negativo o positivo). En la última fila indicamos el sumatorio.

Esta tarea la podemos realizar con VBA creando una función específica. El código que vamos a usar es el siguiente:

Public Function SUMADECIMAL(ByVal miRango As Range) As Variant
'Definimos variables
Dim celda As Range, sCadena As Double
Dim matriz As Variant, nDec As Double
'Recorremos todas las celdas seleccionadas
For Each celda In miRango
'Si la celda contiene un decimal entonces
If celda <> Fix(celda) Then
'seleccionamos la parte decimal
matriz = Split(celda, ",")
'si el numero es menor que cero, entonces es negativo
If celda < 0 Then nDec = matriz(1) * -1
Else
'Si es mayor que cero entonces es positivo
If celda > 0 Then
nDec = matriz(1)
End If
End If
End If
'Sumamos cada decimal extraído
sCadena = sCadena + (nDec * 1)
nDec = 0
Next
'Mostramos el resultado en la función
SUMADECIMAL = Int(sCadena)
End Function

Básicamente, lo que hacemos es extraer de cada celda que no tenga un número entero su parte decimal. Controlando si es o no negativo ese número:

El resultado es el siguiente:

SUMAR LA PARTE DECIMAL DEL CONTENIDO DE UN RANGO NUMÉRICO1

Exactamente el mismo que mostraba más arriba.

Y esto es todo por hoy : )

Descarga el archivo de ejemplo pulsando en: SUMAR LA PARTE DECIMAL DEL CONTENIDO DE UN RANGO NUMÉRICO

¿Te ha resultado de interés?, puedes apoyar a Excel Signum con una pequeña donación.

Donate Button with Credit Cards

¡¡Muchas gracias!!

Mediante la suscripción al blog, la realización comentarios o el uso del formulario de contacto estás dando tu consentimiento expreso al tratamiento de los datos personales proporcionados según lo dispuesto en la ley vigente (LOPD). Tienes más información al respecto en esta página del blog: Política de Privacidad y Cookies

SUMAR LA PARTE ENTERA DEL CONTENIDO DE UN RANGO CON NÚMEROS DECIMALES

Hola a todos!:

Respondiendo a dos consultas, hoy publicaré la respuesta a la más sencilla de las dos y mañana intentaré responder a la segunda.

La pregunta que me trasladan es cómo se pueden sumar todos los enteros de un rango de números decimales. Por ejemplo este rango de números:

SUMAR LA PARTE ENTERA DEL CONTENIDO DE UN RANGO CON NÚMEROS DECIMALES

El resultado de esta suma es: -16,89539, pero a nosotros nos interesa la suma de sus enteros, es decir, 2 + 3 +4 + 6 etc donde el resultado debería ser 18

Para realizar el ejercicio con una fórmula y que contemple todo el rango podemos utilizar o bien una fórmula matricial o bien otra (que no deja de ser otra matricial pero muy especial).

Lo podemos hacer con está fórmula: {=SUMA(TRUNCAR(A2:A10))}  como ya sabéis  las matrices se introducen: seleccionando la celda que contiene la fórmula, pulsando en F2 , seleccionamos la fórmula y luego presionamos CTRL + MAYUS + ENTRAR

SUMAR LA PARTE ENTERA DEL CONTENIDO DE UN RANGO CON NÚMEROS DECIMALES2

Como podéis observar, realiza la suma correctamente y tan solo tenemos que combinar las funciones SUMA y TRUNCAR y activarlas matricialmente.

La segunda forma de hacerlo es utilizando la función sumaproducto combinada con la función TRUNCAR. No será necesario usar matrices ya que la función sumaproducto se expresa matricialmente:

SUMAR LA PARTE ENTERA DEL CONTENIDO DE UN RANGO CON NÚMEROS DECIMALES3

Y efectivamente aquí tenemos el mismo resultado.

Es importante diferenciar las funciones ENTERO y TRUNCAR, que aunque  parece que se obtiene el mismo resultado, la primera redondea con decimales y el resultado podría no ser preciso para esta tarea.

En el próximo post trataré de realizar la inversa, es decir, sumar la parte decimal de un número decimal : )

Descarga el archivo de ejemplo pulsando en: SUMAR LA PARTE ENTERA DEL CONTENIDO DE UN RANGO CON NÚMEROS DECIMALES

¿Te ha resultado de interés?, puedes apoyar a Excel Signum con una pequeña donación.

Donate Button with Credit Cards

¡¡Muchas gracias!!

Mediante la suscripción al blog, la realización comentarios o el uso del formulario de contacto estás dando tu consentimiento expreso al tratamiento de los datos personales proporcionados según lo dispuesto en la ley vigente (LOPD). Tienes más información al respecto en esta página del blog: Política de Privacidad y Cookies