Gráfico de Anillo Comparativo

Hoy toca construir un gráfico comparativo algo distinto, empleando para ello un gráfico de anillo.
La meta es este gráfico:

Estamos viendo como cada serie de datos (cada país) aparece distribuido sobre la circunferencia, comenzando a contar desde el ángulo 270º (desde las 09:00 horas) y llega como tope hasta el punto angular de los 180º (las 06:00 horas).
Todo esto será configurable por nosotros...

Comencemos.
Nuestro datos originales (rango B1:C5), así como una nueva serie auxiliar creada (rango D2:D5) con la fórmula:
=(360/270)*MAX($C$2:$C$5)-C2

En esta primera fórmula comentada:
=(360/270)*MAX($C$2:$C$5)-C2
determinamos con el cociente 360/270 hasta donde llega como máximo en nuestra circunferencia 'virtual' las distintas series.

Para comenzar a construir nuestro gráfico seleccionamos nuestro rango completo B2:D5 y desde la ficha Insertar > Gráficos > circulares > Anillo.

A continuación presionaremos el botón de Cambiar entre filas y columnas !!

Ahora seleccionaremos una serie en el gráfico y aplicaremos formato sobre ella, y desde la Opciones de serie cambiaremos dos propiedades:
1-ángulo del primer sector: a 270º - (nos indica el inicio de las series... en este caso a las 09:00 horas)
2-tamaño del agujero del anillo: a 20%

haz clic en la imagen

Un último paso sería aplicar Sin relleno a los puntos de la serie auxiliar.
Lo haremos desde el formato del punto de datos. Asegúrate tener seleccionado únicamente el punto y no la serie completa!

Listo. El resto son aspectos estéticos como añadir efectos de forma (biseles), colores, etiquetas de datos, etc...

Seguir leyendo...

Invertir items de la leyenda de un gráfico

En esta entrada veremos la manera de conseguir que los items de la leyenda de un gráfico aparezcan en el orden que deseamos....
Fijémonos en la imagen siguiente, y especialmente en la Leyenda... comprobarás que el orden de las series aparecen correctamente ordenados (de izquierda a derecha):

Es fácil comprobar si insertamos un gráfico de barras horizontales directamente, como en la Leyenda las series aparecen de forma contraria a como necesitamos:

Vamos a conseguir invertir los items de la leyenda manteniendo la posición de las series en el área de gráfico.
Para ello incorporamos dos nuevas series de datos con valor cero... y mismo nombre de la serie (los años)

Siguiente paso importante!. Llevamos las dos nuevas series (las que tienen valor cero) al eje secundario, y eliminaremos las etiquetas de dicho eje (seleccionar y borrar).

Otro paso es cambiar los colores de las series nuevas para que coincidan con los originales...
Como curiosidad también se puede hacer directamente desde la Leyenda, seleccionando el punto que representa la serie y desde formato cambiar el relleno (vale cualquiera de las formas tradicionales):

Último paso relevante. Seleccionaremos y borraremos, dentro de la Leyenda, los items que 'nos sobren'... teniendo claro que debemos ver finalmente dos únicos elementos en el orden deseado de izquierda a derecha: 1990 y 2003.
Así pues en el ejemplo borraremos (seleccionar y suprimir) el primero y el último.
El resultado:

El resto hasta llegar al resultado estético deseado es muy personal... y basta con cambiar opciones de formato de las distintas partes del gráfico.

Seguir leyendo...

VBA: Filtrar en un ListBox

Veremos una manera rápida y ágil de mostrar elementos coincidentes similares en un ListBox a partir de un valor introducido en un TextBox.
Ya vimos algo similar en este post, pero en esta ocasión emplearemos las Array en nuestro código para agilizar el traspaso de información...
Nuestros datos en una hoja llamada 'Datos' y un rango A1:C11:

Nuestro formulario, reducido a lo necesario, tendrá:
1- un TextBox llamado 'TxtFiltro'
2- un ListBox llamdao 'ListFiltro'

Así pues añadimos la siguiente macro dentro de la ventana de código de nuestro UserForm en nuestro proyecto de VB:

Private Sub TxtFiltro_Change()
Dim myList() As Variant
Dim X As Long, Y As Long
Dim coincidencia As Boolean
coincidencia = False
Y = 0
'replicamos un filtro a visualizar sobre el ListBox
For X = 2 To Sheets("Datos").Range("A" & Rows.Count).End(xlUp).Row
    If InStr(1, UCase(Sheets("Datos").Range("B" & X).Value), UCase(Me.TxtFiltro.Value)) > 0 Then
        coincidencia = True
        ReDim Preserve myList(2, Y)
        'cargamos nuestra matriz....
        myList(0, Y) = Sheets("Datos").Range("A" & X).Text
        myList(1, Y) = Sheets("Datos").Range("B" & X).Text
        myList(2, Y) = Sheets("Datos").Range("C" & X).Text
        Y = Y + 1
    End If
Next
'si hemos localizado alguna coincidencia...
If coincidencia = True Then
    'mostramos datos coincidentes cargados en nuestra Array
    Me.ListFiltro.List = Application.Transpose(myList)
Else
    Me.ListFiltro.Clear
End If
End Sub
 
Private Sub UserForm_Activate()
Dim var As Variant
'cargamos en una Array el rango de datos...
With Sheets("Datos")
    var = .Range("A2:C" & .Range("A" & Rows.Count).End(xlUp).Row).Value
End With
With Me.ListFiltro
    .ColumnCount = 3 'indicamos número columnas
    .ColumnWidths = "50;50;50" 'determinamos ancho...
    If Not IsEmpty(var) Then
        'si hay datos vaciamos el ListBox
        .Clear
        .List = var
    End If
End With
End Sub

Además del uso de Array, y para compensar el desconocimiento a priori del número de registros coincidentes, hacemos de nuevo uso de la definición de tamaño de una Array, empleando ReDim Preserve, que nos habilita la opcíon de incorporar nuevos registros de manera 'ilimitada' manteniendo los datos cargados.
Esta técnica evita los conteos previos de coincidencias...

Al ejecutar el UserForm comprobaremos cómo a medida escribimos en el TextBox, el filtro se muestra directamente sobre los elementos del campo 'Concepto', tal como buscábamos.

Seguir leyendo...

VBA: Insertar rango de celdas en pie de página

Hoy responderemos la cuestión planteada por un lector, donde preguntaba si existía alguna manera de llevar un rango de celdas al Encabezado o al Pie de página...
Vaya por delante que no hay una forma simple, y que no es posible trasladar un rango como tal... pero sí sería posible trasladar una imagen a ese encabezado pie de página.
Y ese es el trabajo de hoy. Construiremos una macro que capture el rango de celdas con el contenido a incluir como pie de página,
para cargar dicha imagen posteriormente en nuestro pie de página personalizado. Por último eliminaremos la imagen generada...

Este proceso es similar al expuesto en este post.
En él insertamos la captura de imagen dentro de un gráfico vacío, sin datos, para luego emplear el método de exportación de gráfico como imagen.
Imagen que luego será la que cargaremos en el Footer (pie de pagina), mediante la propiedad:
.CenterFooterPicture.Filename = Ruta_de_la_imagen

Nuestra macro añadida dentro de un módulo estándar de nuestro proyecto de VB:

Sub LlevarRangoaPiePagina()
Dim Ruta As String
Dim VistaOriginal As Long

'declaramos el objeto de la hoja sobre la que trabajamos
Set Sh = ThisWorkbook.Sheets("Hoja_Imagenes")

'guardamos la vista actual (normal, diseño de página o salto de página)
VistaOriginal = Windows(ThisWorkbook.Name).View         'ActiveWindow.View
'cambiamos la vista a normal...
'para evitar la posibilida que aparezca el texto 'Página N" en la imagen que crearemos
Windows(ThisWorkbook.Name).View = xlNormalView          'ActiveWindow.View = xlNormalView

'definimos la ruta de la imagen temporal...
Ruta = "E:\excelforo\TEMP.png"

'Exportaremos el área de acuerdo a un escalado adecuado
'proporcionandolo por el zoom existente
Dim coef As Double
coef = CDbl(100 / Windows(ThisWorkbook.Name).Zoom)
'determinamos el área para generar la imagen
Dim RngImg As Range
Set RngImg = Sh.Range("A1:F2")

'copiamos el área
RngImg.CopyPicture Appearance:=xlScreen, Format:=xlPicture

'creamos un gráfico donde incorporar la imagen
'dando unas dimensiones y posición adecuadas...
'ChartObjects.Add(izquierda, arriba, ancho, alto)
Set chartobj = Sh.ChartObjects.Add(0, 30, RngImg.Width * coef, RngImg.Height * coef)

'copiamos el área
RngImg.CopyPicture Appearance:=xlScreen, Format:=xlPicture

'en el cual pegamos el rango guardado como imagen (tal cual se ve en pantalla)
chartobj.Activate
ActiveChart.Paste

'y exportamos dicho gráfico como png
chartobj.Chart.Export Ruta, "png"

'Recuperamos el tipo de vista que teníamos al inicio
Windows(ThisWorkbook.Name).View = VistaOriginal

'configuramos el pié de página para la hoja activa
With Sh.PageSetup
    .CenterFooter = ""    'eliminamos cualquier configuración previa
    .CenterFooter = "&G"    'habilita la vista de la imagen cargada
    .CenterFooterPicture.Filename = Ruta        'indicamos la ruta de la imagen temporal guardada
    'dimensionamos alto y ancho de la imagen en el pié de página
    .CenterFooterPicture.Height = 275
    .CenterFooterPicture.Width = 200
End With

'finalmente eliminamos el gráfico creado
chartobj.Delete
'eliminamos la imagen temporal
Kill Ruta

End Sub

Importante no olvidar incluir la linea de configuración de página:
.CenterFooter = "&G"
que habilita la vista de la imagen cargada!!!

tras lanzar la macro comprobaremos en nuestra vista previa que el rango (en modo imagen) queda visible en la impresión:

Seguir leyendo...

VBA: Subtotales y Repetir etiquetas en tabla dinámicas

Un lector pedía ayuda para mostrar ciertas opciones en su tabla dinámica:
1-Sin subtotales
2-En estilo de diseño Tabular
3-Repitiendo etiquetas de elementos:

[...]En esta ocasión te deseo consultar que codigo utilizar para poner mi tabla dinamica de forma tabular, quitar los subtotales y repetir las etiquetas.[...]

Partimos de una tabla como origen de datos con cuatro campos: Fechas, Conceptos, Categorías e Importe,
a partir de la cual hemos construido una tabla dinámica con dos campos en el área de filas:
Conceptos, Categorías
y el campo de Importe en el área de valores resumido por suma.

El aspecto de la tabla dinámica es que aparecen los subtotales por defecto, no se repiten las etiquetas de elementos y tiene un diseño Compacto.

Con la macro siguiente que incluimos en un módulo estándar de nuestro proyecto conseguiremos los tres puntos que requiere el lector:

Sub OpcionesTablaDinamica()
Dim PT As PivotTable
Dim PF As PivotField

On Error Resume Next
'Definimos el objeto Tabla dinámica sobre el que trabajar
Set PT = Application.ActiveSheet.PivotTables(1)
    'cambiamos a diseño Tabular
    PT.RowAxisLayout xlTabularRow
    'exigimos se repitan las etiquetas
    PT.RepeatAllLabels xlRepeatLabels
    'quitamos los subotales de todos los campos...
    For Each PF In PT.PivotFields
      PF.Subtotals(1) = True
      PF.Subtotals(1) = False
    Next PF
End Sub

El resultado tras ejecutar la macro es el esperado:

Otra posibilidad para eliminar los subotales sobre un campo en concreto:

Sub OpcionesTablaDinamica()
Dim PT As PivotTable
Dim PF As PivotField

On Error Resume Next
Set PT = Application.ActiveSheet.PivotTables(1)
    PT.RowAxisLayout xlTabularRow
    PT.RepeatAllLabels xlRepeatLabels
    'quitamos el Subtotal solo del campo 'concepto'
    With PT.PivotFields("concepto")
        .Subtotals(1) = True
        .Subtotals(1) = False
    End With
End Sub

Seguir leyendo...

Localizar última visita condicionada

Leyendo el título del post puede resultar una pregunta algo 'rara', pero tiene bastante sentido...
Se trata, a partir de un listado de los registros de visitas a nuestros clientes, en qué casos (para qué clientes) han pasado más de seis días desde la última visita.
Supongamos el siguiente listado de registros de visitas, sabiendo que la fecha de hoy es 12/12/2017:

Se observa que tenemos marcadas con color aquellos clientes donde su última visita, respecto al día de hoy, fue superior a los seis días (plazo relevante para nuestro estudio).
Comprobamos como para los clientes E, B y A con fechas de última visita 06/12/2017, 08/12/2017 y 11/12/2017 respectivamente, no exceden de esos seis días estipulados...

El trabajo para conseguir esto es doble, por un lado, componer y crear unas fórmulas matriciales que incorporaremos a unos nombres definidos:
check =(HOY()-fecha)>6
fecha =MAX(SI(Hoja3!$B$3:$B$29=Hoja3!$B3;Hoja3!$C$3:$C$29;0))
Nota: importante que la celda activa esté en la fila 3!!

y por otro lado, seleccionar el rango completo de datos (B3:C29) donde aplicaremos una regla de formato condicional con la siguiente fórmula:
=Y(check;$C3=fecha)
apoyándonos en los nombres definidos anteriores...

haz clic en la imagen

Con lo que queda solucionada nuestra búsqueda.

la clave de este problema es el uso matricial que se hace de fórmulas dentro de los nombres definidos.
En concreto, la fórmula
=MAX(SI(Hoja3!$B$3:$B$29=Hoja3!$B3;Hoja3!$C$3:$C$29;0))
ejecutada matricialmente devolverá para cada fila/cliente la última fecha (la fecha mayor)...esta fecha la emplearemos con el segundo nombre definido para saber si respecto al día actual han transcurrido más de seis días:
=(HOY()-fecha)>6
En conjunto, finalmente dentro del formato condicional se evalúa si es cierto que han pasado más de seis días y si estamos en el caso de ser última fecha de ese cliente...

Seguir leyendo...

VBA: Enviar Rango a Destinatario de correo

Una opción ya en desuso de Excel es el envío a destinatario de correo, que permite adjuntar un rango de celdas seleccionado en el cuerpo de un email, gestionado todo desde nuestra aplicación Excel favorita.

Para las últimas versiones deberemos sacar a la luz el enterrado botón que habilita esta posibilidad;
así pues desde el desplegable de la barra de herramientas de acceso rápido > Más comandos... > Todos los comandos > Enviar a destinatario de correo

Una vez sacado el botón, podemos ejecutarlo, lo que nos llevará a la siguiente ventana... desde donde controlaremos el destinatario/s, el asunto o una breve introducción (en sustitución del típico cuerpo de un email).

Accediendo a Outlook podremos comprobar el envío de dicho email:

Este mismo proceso lo podemos replicar desde nuestra programación y así poder automatizarlo...

Así pues añadimos la siguiente macro dentro de un módulo estándar de nuestro proyecto de VB:

Sub Enviar_Rango_a_Destinatario_de_correo()
   
'Seleccionamos el rango de celdas a enviar Select
ActiveSheet.Range("A1:B5").Select

' Show the envelope on the ActiveWorkbook.
ActiveWorkbook.EnvelopeVisible = True

'Llamamos al envío...
With ActiveSheet.MailEnvelope
   .Item.To = "excelforo@excelforo.com"
   '.Item.cc = "cursos@excelforo.com"            'con copia a...
   '.Item.bcc = "consultoria@excelforo.com"      'con copia oculta a...
   .Item.Subject = "Asunto: Envío rango de Excel por email"
   .Introduction = "Ejemplo de rango adjunto con formato..."
   .Item.Send
End With
End Sub

Al ejecutarlo verificaremos que el resultado es equivalente...

Seguir leyendo...

Encontrando la Suma Acumulada

Hace algunas semanas un lector planteaba una duda sobre cómo localizar la suma acumulada creciente de un dato sobre un rango de celdas...

haz clic en la imagen

La idea es a partir de un rango de celdas C3:C14, y dado un valor acumulado en F3, recuperar el mes al que corresponde dicho importe acumulado (en F3).. directamente sin necesidad de cálculos auxiliares.
En la imagen anterior aparece el cálculo acumulado en D3:D14 para facilitar la comprobación.

haremos uso de una combinación bastante potente y poco conocida, que en este blog ya hemos empleado algunas veces (ver ejemplo1 y ejemplo2).
Hablo del uso matricial de las funciones SUBTOTALES y DESREF.

Para resolver nuestro problema escribimos en G3:
=INDICE(B3:B14;COINCIDIR(F3;SUBTOTALES(109;DESREF(C$3;0;0;FILA(INDIRECTO("1:12"));1));0))
y ejecutamos matricialemente (validando con Ctrl+Mayus+Enter).

La clave del asunto es cómo se obtiene el rango de acumulados creciente por mes con la fórmula:
SUBTOTALES(109;DESREF(C$3;0;0;FILA(INDIRECTO("1:12"));1))
con la que indicamos que vaya sumando/acumulando desde C3 los importes dados, hasta una, dos, tres, ...doce filas por debajo.
Esta sería la matriz devuelta por la fórmula anterior:
{500;886;1695;2386;2666;2848;3074;3843;4132;4448;4565;5428}
que coincide con la calculada en las celdas anexas (D3:D14)...

A partir de aquí el cálculo es simple, con COINCIDIR obtenemos la fila correspondiente, la cual trasladamos como argumento de INDICE sobre el rango de los conceptos o meses B3:B14.

Una vez obtenido la matriz con los importes acumulados, otro cálculo quizá con algo más de sentido (y más simple) sería recuperar el acumulado a una fecha dada, por ejemplo al mes 3, si F7 escribimos 3 :
=INDICE(SUBTOTALES(109;DESREF(C$3;0;0;FILA(INDIRECTO("1:12"));1));F7)
y ejecutamos matricialemente (validando con Ctrl+Mayus+Enter).

Seguir leyendo...