consolidar-informacion-de-varios-archivos-en-una-hoja-excel-con-vba3

CONSOLIDAR INFORMACIÓN DE VARIOS ARCHIVOS EN UNA HOJA EXCEL CON VBA

Hola todos, ¿qué tal vais? ¡Seguro que bien! 🙂

Hoy me gustaría tratar un tema bastante recurrente cuando en nuestros procesos diarios trabajamos con cantidades bastante elevadas de archivos. Me refiero, por ejemplo, a que seamos los receptores de reportes diarios o mensuales de informaciones tipo, ventas, clientes, ingresos, etc.

Cuando sucede esto, solemos acabar con varias carpetas donde vamos almacenando la información por mes o por día y a la que habitualmente acudimos y confeccionamos nuestros reportes COPIANDO Y PEGANDO A MANO.

Esta situación la puedes tener un día, pero no debe darse habitualmente, por ello, he estado trabajando en un macro para resolver este problema.

Vamos a realizar un caso práctico, y vamos a utilizar nuestra base de datos de ejemplo, la del personal ficticio de unos grandes almacenes. En total son 180 empleados:

consolidar-informacion-de-varios-archivos-en-una-hoja-excel-con-vba

Para realizar un ejemplo, vamos a crear tres libros con tres hojas cada uno y en cada pestaña pegaremos 20 empleados y luego guardamos los archivos en una carpeta (CONSOLIDADO):

consolidar-informacion-de-varios-archivos-en-una-hoja-excel-con-vba1

La idea es que con mediante un proceso podamos juntar de nuevo todas las hojas en un único archivo.

Para configurar nuestra hoja vamos a crear dos pestañas, una que vamos a denominar “CONSOLIDAR”,  y otra, en la segunda hoja que vamos a denominar “AGRUPADO”.

En la primera hoja colocaremos un botón de acción para ejecutar la macro y la segunda nos servirá para agrupar toda la información.

Una vez realizado esto, ya podemos pegar la siguiente macro:

Sub CONSOLIDAR()
Dim path As String, MiLibro As String
Dim FilaInicio As Integer
Dim i As Integer
Dim iArchivo As String
Dim iRango As Range, dRango As Range
Dim Hoja_Destino As Worksheet, iLibro As Workbook
'Creamos ventana de diálogo para seleccionar ruta al directorio o carpeta
On Error Resume Next
With CreateObject("shell.application")
path = .browseforfolder(0, Titulo, 0).Items.Item.path
End With: On Error GoTo 0
If path = Empty Then
Exit Sub
End If
'Determinamos a partir de que fila vamos a consolidar los datos
'Normalmente fila 2 si tenemos encabezados de columna
FilaInicio = 2
'Desactivamos actualizacion de pantalla y eventos
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Identificamos el nombre de nuestro libro
MiLibro = ThisWorkbook.Name
'Limpiamos datos en la hoja "AGRUPADO" para actualizar la informacion
ThisWorkbook.Sheets("AGRUPADO").Range("A2:H65000").ClearContents
'Indicamos la hoja de destino de los datos que queremos consolidar
Set Hoja_Destino = ThisWorkbook.Sheets("AGRUPADO")
'Identificamos y listamos los archivos Excel en el directorio (por orden de fecha de modificación)
iArchivo = Dir(path & "\*.xl*", vbNormal)
'Si la longitud del archivo es cero, salimos del proceso (no existe archivo para consolidar)
If Len(iArchivo) = 0 Then Exit Sub
' Mientras el largo del archivo sea mayor de 0 iniciamos el proceso
Do While Len(iArchivo) > 0
'Si el nombre del archivo no es igual a nuestro libro seguimos el proceso
If Not iArchivo = MiLibro Then
'Capturamos ruta al iarchivo
Set iLibro = Workbooks.Open(Filename:=path & "\" & iArchivo)
'Contamos las hojas que tiene
fin = iLibro.Sheets.Count
'Iniciamos un bucle por cada hoja, donde seleccionamos los datos desde la fila 2
'hasta el final de la hoja (siempre sin filas en blanco)
'Luego copiamos los datos en la Hoja_Destino, que es la Hoja "AGRUPADO"
'Colocándolos al final de los rangos que se vayan pegando
For i = 1 To fin
iLibro.Sheets(i).Select
Set iRango = iLibro.Sheets(i).Range(Cells(FilaInicio, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, Cells(1, Columns.Count).End(xlToLeft).Column))
Set dRango = Hoja_Destino.Range("A" & Hoja_Destino.Cells(Rows.Count, 1).End(xlUp).Row + 1)
iRango.Copy
dRango.PasteSpecial xlPasteValues
Next
'Cerramos el libro y continuamos el proceso
Application.CutCopyMode = False
iLibro.Close False
End If
iArchivo = Dir()
Loop
' Si queremos podemos ordenar la información consolidada, en este caso por ID.
' Podemos obviar esta parte si no necesitamos ordenar los datos.
With ThisWorkbook.Sheets("AGRUPADO")
D_fin = Application.CountA(.Range("A:A"))
.Range("A1:G" & D_fin).Sort Key1:=Range("A1"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
.Range("A1").Select
.Columns.AutoFit
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
' Una vez finalizado, lanzamos mensaje de finalización.
MsgBox ("EL PROCESO HA FINALIZADO CORRECTAMENTE"), vbInformation, "PROCESO DE CONSOLIDACIÓN"
End Sub

Como podéis observar, he incluido un buscador de directorios o carpetas de forma que no sea necesario modificar la macro para hacer referencia a la ruta de los archivos.

With CreateObject("shell.application")
path = .browseforfolder(0, Titulo, 0).Items.Item.path

Tan solo hay que seleccionar la carpeta donde los hemos guardado. El resto de la macro, lo voy explicando en el propio archivo.

Sí que me gustaría comentar lo siguiente, para indexar los archivos tipo Excel (*xl*) que vamos a consolidar he utilizado la función Dir().

iArchivo = Dir(path & "\*.xl*", vbNormal)

Efectivamente, lista los archivos que iremos procesando y lo hace correctamente. Sin embargo, en caso que necesitásemos que se fueran procesando ordenados por nombre, no podríamos hacerlo, la función ordena según la fecha de modificación del archivo, de la más antigua a la más reciente. Por ello, si los archivos que queremos consolidar han de llevar un cierto orden se debe tener en cuenta la fecha de modificación.

Para solucionar esta limitación de la función DIR(), al final de la macro, he añadido una pequeña instrucción que nos ordenará la hoja “AGRUPADO” por, por ejemplo, el ID. Y así tendremos los datos en orden.

Si no necesitáis que estén ordenados, simplemente elimináis la última parte:

D_fin = Application.CountA(.Range("A:A"))
.Range("A1:G" & D_fin).Sort Key1:=Range("A1"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

Pues esta ha sido la entrada de hoy, espero que os resulte de tanta utilidad como a mi (y os ahorre tiempo).

Os dejo el archivo de la macro.

Descarga el archivo de ejemplo pulsando en: CONSOLIDAR INFORMACIÓN DE VARIOS ARCHIVOS EN UNA HOJA EXCEL CON VBA

Y aquí la carpeta de ejemplo con los 3 archivos (esta en Drive, dado que en WordPress no se permite subir carpetas al servidor):  ARCHIVOS DE EJEMPLO PARA PRUEBAS

eliminar-todas-las-imagenes-formas-de-una-hoja-o-un-libro-en-excel-con-vba

ELIMINAR TODAS LAS IMÁGENES (FORMAS) DE UNA HOJA O UN LIBRO EN EXCEL CON VBA

Hace unos días recibí una consulta sobre cómo se podría modificar el tamaño de todas las imágenes de una hoja o de un libro mediante una macro.

Aunque este tema ha sido muy tratado en diferentes webs y foros de internet, me ha parecido útil escribir un post acerca del tratamiento de imágenes (o mejor, de cualquier objeto de la colección shapes).

Es decir, en Excel podemos estar trabajando con una fotografía, un organigrama de SmarArt, un gráfico o un objeto Ole, etc).  Todo ellos objetos que forman parte de la colección Shapes.

Siguiendo un caso práctico, imaginad que tenemos un libro con las siguientes formas (imágenes, autoformas, llamadas, objeto SmartArt):

eliminar-todas-las-imagenes-formas-de-una-hoja-o-un-libro-en-excel-con-vba

Dicho esto, si quisiéramos eliminar todos los objetos de la primera hoja de nuestro libro, lo haríamos así:

Sub Borrar_Hoja()
Dim Shape As Excel.Shapes
'Por cada forma en la hoja 1
For Each Shapes In Sheets(1).Shapes
' Eliminamos forma
With Shapes
.Delete
End With
Next
End Sub

Si quisiéramos eliminar todas las formas (Shapes) que existen el libro, tendríamos que utilizar la macro anterior pero dentro de un bucle for – next que recorra todas las hojas del libro:

Sub Borrar_Libro()
Dim nHoja As Integer
Dim Shape As Excel.Shapes
'Contamos las hojas del libro activo
nHoja = ActiveWorkbook.Worksheets.Count
'Inicimiamos bucle.
For i = 1 To nHoja
'En cada hoja seleccionamos todas las formas
For Each Shapes In Sheets(i).Shapes
'y las borramos
With Shapes
.Delete
End With
Next
Next i
End Sub

Sin embargo, si solo queremos eliminar un tipo de forma, tendríamos que especificar en el código el tipo que deseamos eliminar. Antes de seguir, os dejo un enlace a Microsoft donde se especifica el nombre y valor de todas las formas de la colección shapes:

https://msdn.microsoft.com/en-us/library/office/ff860759.aspx

eliminar-todas-las-imagenes-formas-de-una-hoja-o-un-libro-en-excel-con-vba1

*en el caso del valor 24, como observaréis, he modificado el Name que aparece publicado en Microsoft en el enlace de Microsoft (msoIgxGraphic) por (msoSmartArt), el motivo es que he probado el nombre msoIgxGraphic en todas las versiones desde 2010 en adelante y no funciona, pero sí lo hace con msoSmartArt.

Por lo tanto, para realizar la prueba vamos a elegir un tipo determinado de forma a eliminar, tanto en la primera hoja como en todo el libro. La elección serán las fotografías, que equivalen según el cuadro anterior a msoPicture y con valor 13.

Para eliminar las fotografías de la primera hoja, usaremos el siguiente código:

Sub Borrar_Hoja_Tipo()
Dim Shape As Excel.Shapes
'Por cada forma en la hoja 1
For Each Shapes In Sheets(1).Shapes
' Eliminamos forma
With Shapes
'Si la forma es entonces la borramos
If .Type = 13 Then
.Delete
End If
End With
Next
End Sub

Y para eliminar las fotografías en todo el libro, usaremos el siguiente:

Sub Borrar_Libro_Tipo()
Dim nHoja As Integer
Dim Shape As Excel.Shapes
'Contamos las hojas del libro activo
nHoja = ActiveWorkbook.Worksheets.Count
'Inicimiamos bucle.
For i = 1 To nHoja
'En cada hoja seleccionamos/detectamos todas las formas
For Each Shapes In Sheets(i).Shapes
With Shapes
'Si la forma es entonces la borramos
If .Type = 13 Then
.Delete
End If
End With
Next
Next i
End Sub

El resultado después de aplicar la macro sería este:

eliminar-todas-las-imagenes-formas-de-una-hoja-o-un-libro-en-excel-con-vba2

Y hemos eliminado las fotografías en todo el libro.

Evidentemente, podemos utilizar las macros para cualquier otro tipo de acción sobre las formas, como por ejemplo darle formato, colores, alto, ancho, etc … Pero para este ejemplo, nos hemos limitado a eliminar (en otros post que tengo pensado ir publicando iremos trabajando otras acciones).

En el archivo adjunto os dejo las macros. Sin embargo los botones que he dejado para ejecutarlas, solo son para los casos donde determinamos el tipo de forma a eliminar. Las macros que eliminan todas las formas de la hoja y del libro, si pusiese un botón en la hoja, directamente lo eliminaría, dado que también se trata de una forma (control de formulario).

Espero que os sea de utilidad 🙂

Descarga el archivo de ejemplo pulsando en: ELIMINAR TODAS LAS IMÁGENES DE UNA HOJA O UN LIBRO EN EXCEL CON VBA

combinar-correspondencia-en-excel-y-guardar-en-pdf4

COMBINAR CORRESPONDENCIA EN EXCEL Y GUARDAR EN PDF

Hola a todos!, espero que todo os vaya bien 🙂

Llevo varias semanas que no publico nuevo material, el motivo no es otro que la falta de tiempo. Lo cierto es que entre la temporada veraniega, la reincorporación al trabajo y temas pendientes, se hace complicado sacar un momento para escribir nuevas entradas.

Estos días sin embargo, tuve tiempo para preparar un post bastante interesante. Como suele ser habitual, el tema surgió a raíz de una consulta de una lector. Me preguntaba acerca de la posibilidad de realizar combinar correspondencia en Excel y poder pasar cada uno de los documentos a PDF de forma individual.

Normalmente, el proceso de combinar correspondencia se inicia desde Microsoft Word y se accede a Excel para buscar la base de datos en la que tenemos la información necesaria para enviar la correspondencia. Prácticamente se pueden realizar todo tipo de envíos masivos y enviar la información a través de correo electrónico. También se pueden imprimir los documentos (es posible que con paciencia se puedan imprimir con algún programa a PDF de uno en uno, especificándolo en el cuadro de diálogo de la impresora).
Para más información sobre combinar correspondencia os dejo el siguiente enlace: COMBINAR CORRESPONDENCIA

Pues bien, en casi la totalidad de los casos podremos solucionar nuestras necesidades con Word. Pero si queremos pasar cada uno de los archivos que queremos enviar a PDF y guardarlos en un directorio, Excel es una buena solución. Para hacerlo, debemos construir nuestra propia aplicación de combinar correspondencia.

Después de este pequeño comentario, ya estamos listos para comenzar. Como siempre, vamos a ver la base de datos que hemos confeccionado para enviarles una comunicación, pestaña “DATOS”:

combinar-correspondencia-en-excel-y-guardar-en-pdf

El siguiente paso ahora es crear la plantilla que vamos a utilizar para incorporar los datos a enviar. La plantilla la vamos a crear directamente en una hoja Excel, lo haremos teniendo en cuenta los formatos que podemos darle al texto en cada línea de la hoja, y además crearemos una serie de marcadores que luego vamos a utilizar para trasladar los datos de cada persona. Esta es la plantilla:

combinar-correspondencia-en-excel-y-guardar-en-pdf1

Como podéis observar, aquellos campos que hacen referencia a los datos que iremos incorporando en cada carta los marcaremos entre corchetes “<>”, luego en la macro haremos referencia a ellos para reemplazarlos.

Es importante que vayáis configurando en cada línea lo datos de la forma en la que saldrán finalmente, aunque esto lo podéis hacer realizando varias pruebas para depurar el diseño.

La plantilla “GENERAR” no contiene datos, será la hoja en la que se vuelque una copia de “PLANTILLA” y en la que iremos colocando cada registro de la hoja “DATOS”. Lo que sí es importante es que en la hoja “GENERAR”, las líneas y las columnas tengan en mismo ancho que la hoja “PLANTILLA”, o por lo menos tener en cuenta que el PDF final tendrá el mismo formato que la hoja “GENERAR”:

combinar-correspondencia-en-excel-y-guardar-en-pdf2

Ahora que ya tenemos la carta incorporada en nuestro archivo y las hojas creadas, ya podemos ir a la programación, debemos incluir esta macro:

Sub COMBINAR_CORRESPONDENCIA()
Dim i As Double
Dim ruta As String
Application.ScreenUpdating = False
'Activamos nuestro libro
ThisWorkbook.Activate
Sheets(2).Name = "GENERAR"
'seleccionamos hoja "GENERAR"
Sheets("GENERAR").Select
'Contamos el número de casos
Fin = Application.CountA(Sheets("DATOS").Range("A:A"))
'Elegimos la carpeta donde queremos guardar los archivos
On Error Resume Next
With CreateObject("shell.application")
ruta = .browseforfolder(0, Titulo, 0).Items.Item.Path
End With: On Error GoTo 0
'Si no elegimos la carpeta de destino, la macro se para
If ruta = Empty Then
MsgBox "DEBES SELECCIONAR UNA CARPETA DE DESTINO, PULSA DE NUEVO EL BOTÓN GENERAR", vbExclamation
Exit Sub
End If
'Iniciamos un for
For i = 2 To Fin
'Creamos variables para cada uno de los datos a incorporar en la hoja "GENERAR"
Nombre = Sheets("DATOS").Cells(i, 1)
Apellidos = Sheets("DATOS").Cells(i, 2)
Lugar = Sheets("DATOS").Cells(i, 3)
Fecha = Format(Sheets("DATOS").Cells(i, 4), "[$-C0A]d ""de"" mmmm ""de"" yyyy;@")
ExcelSignum = Sheets("DATOS").Cells(i, 5)
Email = Sheets("DATOS").Cells(i, 6)
Firma = Sheets("DATOS").Cells(i, 7)
'Llamamos a la macro Actualiza
Call ACTUALIZA
'Damos nombre a la hoja activa, que es GENERAR
ActiveSheet.Name = Sheets("DATOS").Cells(i, 1) & " " & Sheets("DATOS").Cells(i, 2)
With ActiveSheet
'Reemplazamos los datos en los marcadores que hemos creado en Plantilla
Cells.Replace What:="<NOMBRE>", Replacement:=Nombre, LookAt:=xlPart, SearchOrder:=xlByRows
Cells.Replace What:="<APELLIDO>", Replacement:=Apellidos, LookAt:=xlPart, SearchOrder:=xlByRows
Cells.Replace What:="<LUGAR>", Replacement:=Lugar, LookAt:=xlPart, SearchOrder:=xlByRows
Cells.Replace What:="<FECHA>", Replacement:=Fecha, LookAt:=xlPart, SearchOrder:=xlByRows
Cells.Replace What:="<EXCEL SIGNUM>", Replacement:=ExcelSignum, LookAt:=xlPart, SearchOrder:=xlByRows
Cells.Replace What:="<EMAIL>", Replacement:=Email, LookAt:=xlPart, SearchOrder:=xlByRows
Cells.Replace What:="<FIRMA>", Replacement:=Firma, LookAt:=xlPart, SearchOrder:=xlByRows
'Si queréis dar formato de hipervínculo a las celdas A6 y A10
'Solo tenéis que descomentar la parte indicada entre puntos:
'-----------------------------------------------------------
.Range("A6,A10").Select
With Selection
.Font.Color = RGB(0, 0, 255)
.Font.Underline = xlUnderlineStyleSingle
End With
'-----------------------------------------------------------
End With
'Publicamos en PDF, sin propiedades en el documento y sin abrir cada vez que se genere el PDF
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ruta & "\" & ActiveSheet.Name, Quality:=xlQualityStandard, _
IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=False
'Volvemos a renombrar la hoja2 como "GENERAR"
Sheets(2).Name = "GENERAR"
Next
End Sub

Con esta macro debemos adjuntar esta otra, a la que hacemos referencia en la macro principal:

Sub ACTUALIZA()
Dim Shape As Excel.Shape
'Limpiamos contenidos en hoja "GENERAR"
Sheets("GENERAR").Select
Columns("A:A").ClearContents
'Eliminamos imagenes en la hoja Generar
For Each Shape In Sheets("GENERAR").Shapes
Shape.Delete
Next
'Copiamos la plantilla base desde la hoja "PLANTILLA" a "GENERAR"
'Seleccionamos el rango de FILAS hasta donde tenemos texto o un rango superior
Sheets("PLANTILLA").Select
Rows("1:50").Select
Selection.Copy
Sheets("GENERAR").Select
Rows("1:50").Select
ActiveSheet.Paste
End Sub

Cuando la macro se ejecute, directamente nos va a preguntar por una ubicación (directorio) en la que queremos guardar cada uno de los PDF generados. Si no elegimos, saldremos la macro y se parará el proceso. Si la elegimos, la macro pasará los datos a la hoja “GENERAR” mediante el comando reemplazar y sustituirá cada uno de registros marcados a través de un bucle for-next.

La otra macro, lo que hace es limpiar de todo contenido la hoja “GENERAR” incluso objetos, como firmas escaneadas, imágenes, logos, etc y traslada el texto de la hoja “PLANTILLA”.

Finalmente, guardamos la hoja “GENERAR” denominando a cada PDF con el nombre de las personas, el resultado es este:

combinar-correspondencia-en-excel-y-guardar-en-pdf3

y la comunicación esta:

combinar-correspondencia-en-excel-y-guardar-en-pdf4

De esta forma tendremos todos los archivos en PDF y guardados en el mismo directorio.

En la macro, os he dejado parte del código comentado, ese código sirve para dar formato a los hipervínculos que se mostrarán en el PDF si queremos que se destaquen en azul y subrayados. Es solo una medida puramente estética, el hipervínculo funciona perfectamente.

Y esto es todo, espero que os sea de utilidad.  🙂

Importante: la macro ha sido probada en Excel 2010, 2013 y 2016. En 2007 debería funcionar correctamente, dado que permite pasar documentos a PDF. En versiones anteriores no funcionará.

Descarga el archivo de ejemplo pulsando en: COMBINAR CORRESPONDENCIA EN EXCEL Y GUARDAR PDF

 

crear-nombre-definido-en-excel-con-vba3

CREAR NOMBRE DEFINIDO EN EXCEL CON VBA

Hace unos días recibí una breve consulta acerca de cómo crear y actualizar un nombre definido en Excel mediante VBA.

Dado que la petición me pareció interesante, he desarrollado una pequeña macro que añade o actualiza nombres definidos en la macro.

Pero antes de entrar en el código, vemos los datos que nos van a servir de ejemplo, realizaremos el ejercicio con la base de datos habitual que suelo utilizar de ejemplo, empleados de unos grandes almacenes:

CONECTAR BASE DE DATOS DE EXCEL_1

Los nombres definidos se pueden crear de dos formas o métodos:

1 – Crear nombre definido desde la selección: donde Excel crea automáticamente el nombre a partir de los datos que tengamos seleccionados en la hoja Excel. Este es el comando:

crear-nombre-definido-en-excel-con-vba1

Además permite crear el nombre a partir de los valores de la primera fila, la última fila, la columna izquierda o la columna derecha. Además en caso de que el nombre definido (nombre) tenga espacios o empiece por un carácter numérico, automáticamente añade un carácter de subrayado “_”.

Para este método 1 vamos a utilizar la siguiente macro:

Sub NombresDefinidos_metodo1()
Dim i As Double
Sheets("DATOS").Select
With Sheets("DATOS")
'Contamos las columnas con datos sobre las que crear el nombre definido
Fin = Application.CountA(Worksheets("DATOS").Range("1:1"))
'Desactivamos las notificaciones al actualizar los nombres
Application.DisplayAlerts = False
'Mediante un "for" creamos nombre definido por cada columna
For i = 1 To Fin
Range(Cells(1, i), Cells(1, i).End(xlDown)).Select
Selection.CreateNames Top:=True, Left:=False, Bottom:=False, Right:= _
False
Next
'Activamos las notificaciones
Application.DisplayAlerts = True
End With
End Sub

2 – Crear nombre definido asignándolo manualmente: los nombres definidos también se pueden crear de forma manual especificando nombre, ámbito (hoja o libro) y rango. Esto se realiza a través de este comando:

crear-nombre-definido-en-excel-con-vba2

En este caso, el sistema no formatea el nombre con el carácter “_” sino que debes introducirlo tú directamente en caso de que la palabra que define al nombre contenga espacios o empiece por un número.

Para este método vamos a utilizar la siguiente macro:

Sub NombresDefinidos_metodo2()
'Declaramos las variables
Dim Nombre As String
Dim Seleccion As Range
'Con la hoja activa
With ActiveSheet
'Contamos las columnas
Fin = Application.CountA(.Range("1:1"))
'Iniciamos un "for" seleccionamos rangos de las columnas a partir de la segunda
'fila
For i = 1 To Fin
Set Seleccion = Range(Cells(2, i), Cells(2, i).End(xlDown))
'Si el nombre tiene espacios los sustituimos por "_"
Nombre = Application.WorksheetFunction.Substitute(.Cells(1, i).Value, " ", "_")
'Si el nombre comienza por número anteponemos un "_" (caracter subrayado)
If Mid(Nombre, 1, 1) = IsNumeric(Mid(Nombre, 1, 1)) Then
Nombre = "_" & Nombre
End If
'Agregamos nombre definido, o bien al libro o a la página
ActiveSheet.Names.Add Name:=Nombre, RefersTo:=Seleccion
Next
End With
End Sub

Como podéis observar he introducido unas líneas en el código para formatear el nombre en caso de espacios o de empezar por un número:

'Si el nombre tiene espacios los sustituimos por "_"
Nombre = Application.WorksheetFunction.Substitute(.Cells(1, i).Value, " ", "_")
'Si el nombre comienza por número anteponemos un "_" (caracter subrayado)
If Mid(Nombre, 1, 1) = IsNumeric(Mid(Nombre, 1, 1)) Then
Nombre = "_" & Nombre
End If

Para finalizar, me gustaría añadir una tercera macro que puede resultar de utilidad, un código que borra todos los nombres definidos de nuestro proyecto. La dejo en el archivo en otro módulo (aunque se puede introducir en las macros anteriores con un “Call” para que se ejecute en el mismo proceso):

Sub Elimina_nombres()
Dim Nombre As Name
'Por cada nombre definido en el libro, lo eliminamos.
For Each Nombre In ActiveWorkbook.Names
Nombre.Delete
Next Nombre
End Sub

En resumen, en ambos casos podemos añadir automáticamente nombres definidos al libro que estamos utilizando, pero solo en la segunda macro vamos a poder especificar si queremos que el ámbito del nombre sea el libro o la hoja (activa).

Este es el resultado de aplicar cualquiera de las dos macros:

crear-nombre-definido-en-excel-con-vba3

Y con estas dos macros ya podemos añadir y actualizar nombres definidos a nuestra hoja o libro Excel 🙂

Descarga el archivo de ejemplo pulsando en: CREAR NOMBRE DEFINIDO EN EXCEL CON VBA

 

calcular-promedio-sin-tener-en-cuenta-ceros2

CALCULAR PROMEDIO SIN TENER EN CUENTA LOS CEROS

Hola a todos,

Espero que hayáis disfrutado del verano y de las vacaciones 🙂 seguro que sí!!. Bien, hoy voy a realizar una entrada muy corta pero que se presenta muy habitualmente en nuestras hojas de cálculo: el cálculo de los promedios sin tener en cuenta los ceros.

La función “Promedio” en Excel calcula el promedio en un rango definido de datos, es una fórmula sencilla y muy útil. No tiene en cuenta las celdas que no contienen datos (vacías) pero sí que tiene en cuenta las celdas que contienen un “0”.

Normalmente esto no representa un problema, el cero se asume con un número más y se realiza el promedio. Pero ¿qué sucede si no debemos tener en cuenta los ceros en nuestros cálculos?, por ejemplo, en los resultados de facturación de un grupo de vendedores en el primer semestre del año, imaginad que se han ido de vacaciones (y que todos han tomado el mes que le corresponde). Veamos el cálculo del promedio con la fórmula habitual:

calcular-promedio-sin-tener-en-cuenta-ceros1

Así es, el promedio por línea se calcula así:

=PROMEDIO(C3:I3)

Como podéis observar en el primer caso, el comercial Arturo ha facturado un promedio de 1.352,14 euros en el primer semestre. Pero dado que en Julio se fue de vacaciones y en nuestra empresa tenemos este dato muy en cuenta, el promedio lo queremos obtener de aquellos meses en los que ha trabajado. En realidad Arturo ha obtenido un promedio de 1.557,50 euros (fruto de los meses de Enero a Junio).

Esto lo vamos a calcular con una fórmula matricial que va a omitir del cálculo del promedio aquellas celdas que contengan un “0”, ya sabéis que para introducir una fórmula matricial es necesario que seleccionéis la fórmula y luego pulséis: Ctrol + Alt + Enter.

{=PROMEDIO(SI(C17:I17<>0;C17:I17))}

En el cuadro de abajo tenemos los cálculos correctamente realizados:

calcular-promedio-sin-tener-en-cuenta-ceros2

Como se puede ver, la diferencia es importante y es algo que se debería tener en cuenta a la hora de realizar promedios.

Descarga el archivo de ejemplo pulsando en: CALCULAR PROMEDIO SIN TENER EN CUENTA LOS CEROS

CREAR ARBOL DE DECISIÓN CON SMARTART Y VBA5

CREAR ÁRBOL DE DECISIÓN CON SMARTART Y VBA

Hace unos días, un lector me comentaba que el post que había realizado sobre crear organigramas en SmartArt, también se podía adaptar para realizar un árbol de decisión. Y es cierto, de hecho las estructuras jerárquicas que aparecen en SmartArt sí que sugieren su idoneidad para crear árboles de decisión.

Por lo que hoy realizaré un pequeño ejercicio de ejemplo para comprobar cómo se adapta a un caso práctico. Recomiendo complementar la lectura de esta entrada con estos dos post:

Investigando por internet he dado con una página muy interesante sobre árboles de decisión, cuyo autor es Federico Garriga Garzón y que se titula Problemas Resueltos de Teoría de Decisión

De todos los ejercicio expuestos, he elegido el que más me ha gustado, pero podéis adaptar el que queráis. Es el ejercicio 19 y su enunciado dice así:

Una empresa está considerando la posibilidad de contratar un experto en ingeniería industrial para la planificación de su estrategia de operaciones. Una adecuada planificación supondría a la empresa unos beneficios de 1.000.000 de euros, mientras que si la planificación no fuera correctamente elaborada, la empresa estima unas pérdidas de 400.000 euros. El director industrial estima que la probabilidad de que el experto realice una adecuada planificación es del 75%. Antes de contratar al experto, la empresa tiene la opción de realizar unas pruebas para determinar la idoneidad del candidato, dichas pruebas tienen una fiabilidad del 80% a la hora de determinar el éxito potencial del candidato en la realización de la planificación de las operaciones de la empresa. Determine la decisión óptima para la empresa, así como el coste que puede asumir la empresa por realizar la prueba de idoneidad.

Pues bien, antes de comenzar y como se indica en la solución, lo primero que debemos hacer es confeccionar el árbol de decisión, solo con las decisiones, sin indicar cálculos. Tomando este ejemplo, los datos que debemos escribir para generar la estructura en gráfico serían estos:

CREAR ARBOL DE DECISIÓN CON SMARTART Y VBA2

Y ejecutando la macro (que más adelante os mostraré) generamos esta estructura:

CREAR ARBOL DE DECISIÓN CON SMARTART Y VBA1

Ahora, siguiendo los pasos del ejercicio, debemos realizar los cálculos necesarios que nos ayuden a calcular coste y el criterio para tomar una decisión óptima.

Los cálculos los realizaré en otra hoja (“CÁLCULOS”), para más información y detalle, os remito al ejercicio para consultar fórmulas, conceptos y teorías aplicadas. Estos serían los cálculos (primero mostrando las fórmulas y luego con los resultados):

CREAR ARBOL DE DECISIÓN CON SMARTART Y VBA3

CREAR ARBOL DE DECISIÓN CON SMARTART Y VBA4

Una vez que tenemos todos los datos calculados, solo tenemos que trasladarlos a la hoja (“DATOS”) e ir añadiendo información en las columnas de la derecha, así:

CREAR ARBOL DE DECISIÓN CON SMARTART Y VBA6

En la columna “D” vamos a colocar los cálculos que se refieren a las probabilidades condicionadas, las probabilidades a priori de cada acontecimiento (si es o no idóneo el candidato) y la aplicación del teorema de Bayes en función de contratar al candidato si es o no idóneo y la planificación es o no idónea), el dato irá en rojo.

En la columna “E” indicamos que si se trata de una planificación correcta, el beneficio esperado es de 1.000.000 euros y si es incorrecta las pérdidas serían de  (400.000) euros.

Finalmente en la columna “F” la calculamos directamente en la hoja (“DATOS”) resolviendo de derecha a izquierda (siguiendo el gráfico) y aplicando criterio de esperanza matemática calculando el beneficio esperado de cada decisión. Una vez realizado el cálculo para los tres nudos a la derecha, debemos colocar el resultado (beneficio) mayor en el siguiente nudo. De esta forma determinar mediante criterio de esperanza matemática entre las dos decisiones (Si es o no idóneo el candidato).

Finalmente, y como se comenta en la solución del ejercicio, dado que la última etapa es determinista, se debe elegir la alternativa cuyo beneficio sea mayor. Colocamos los resultados en azul y según cada línea de decisión.

La columna “C” hace referencia a los niveles de decisión, en este caso tenemos 4 niveles con sus nodos correspondientes.

Ahora ejecutamos esta macro para generar el árbol de decisión:

Sub ARBOL_DECISION()
Dim Diseño As SmartArtLayout
Dim Shape As Excel.Shape
Dim oNodos As SmartArtNodes
Dim i, j, Fin As Double
With Sheets("ARBOL")
.Select
'Borramos cualquier forma que se encuentre en la hoja ARBOL
For Each Shape In .Shapes
Shape.Delete
Next
'Insertamos gráfico SmartArt, recomendable utilizar el de nombre y puesto
Set Diseño = Application.SmartArtLayouts("urn:microsoft.com/office/officeart/2008/layout/NameandTitleOrganizationalChart") 'Diseño de la forma Smartart
Set Inserta = .Shapes.AddSmartArt(Diseño)
Set oNodos = Inserta.SmartArt.AllNodes
'Damos formato los colores y estilos rápidos
With Sheets("ARBOL")
For Each Shape In .Shapes
Shape.SmartArt.Color = Application.SmartArtColors("urn:microsoft.com/office/officeart/2005/8/colors/accent0_1") ' Colores disponibles
Shape.SmartArt.QuickStyle = Application.SmartArtQuickStyles("urn:microsoft.com/office/officeart/2005/8/quickstyle/3d5") 'Estilos rápidos
Next
End With
'colocamos la estructura a partir de la fila 3 y columna 1
.Shapes(1).Left = .Cells(3, 1).Left
.Shapes(1).Top = .Cells(3, 1).Top
Fin = Application.CountA(Sheets("DATOS").Range("A:A"))
'Creamos y eliminamos nodos según jerarquía y cantidad de nodos indicados en la DATOS
Do While oNodos.Count < Fin
oNodos.Add.Promote
Loop
For i = 1 To Fin
Do While oNodos(i).Level < Sheets("DATOS").Range("C" & i).Value
oNodos(i).Demote
Loop
With oNodos(i)
' Añadimos los datos de las columnas
v0 = Sheets("DATOS").Range("B" & i)
v1 = Sheets("DATOS").Range("D" & i)
v2 = Sheets("DATOS").Range("E" & i)
v3 = Sheets("DATOS").Range("F" & i)
'Contamos las palabras de cada columna
cv0 = UBound(Split(v0)) + 1
cV1 = UBound(Split(v1)) + 1
cv2 = UBound(Split(v2)) + 1
cv3 = UBound(Split(v3)) + 1
'Escribimos en cada nodo el contenido de las columnas
.TextFrame2.TextRange.Text = v0 & " " & v1 & " " & v2 & " " & v3
'Damos color (rojo y azul) a los valores de la misma forma que en el ejecicio de ejemplo
.TextFrame2.TextRange.Words(cv0 + 1, cV1).Font.Fill.ForeColor.RGB = vbRed
.TextFrame2.TextRange.Words(cv0 + cV1 + cv2 + 1, cv3).Font.Fill.ForeColor.RGB = vbBlue
End With
Next i
End With
'Formateamos el diseño del organigrama, lo presentamos con jerarquía horizontal "hierachy2"
With Sheets("ARBOL")
For Each Shape In .Shapes
Shape.SmartArt.Layout = Application.SmartArtLayouts("urn:microsoft.com/office/officeart/2005/8/layout/hierarchy2")
Next
End With
'Aumentamos zoom para ver correctamente el gráfico
ActiveWindow.Zoom = 180
'Liberamos variables
Set Diseño = Nothing
Set Inserta = Nothing
Set oNodos = Nothing
End Sub

He introducido algunas líneas de código nuevas para visualizar mejor el gráfico, (colocación y zoom) y también he implementado un pequeño sistema para colorear los ítems calculados y que forman parte del esquema.

Y el resultado es el siguiente:

CREAR ARBOL DE DECISIÓN CON SMARTART Y VBA5.jpg

Como podéis observar, el beneficio esperado es de 650.140 euros, fruto de la elección de mayor beneficio, entre “Hacer las pruebas: 650.140 euros” o “Contratar a un experto: 650.000 euros”. Es decir, el coste máximo que puede llegar a asumir la empresa para realizar las pruebas de idoneidad es de 140 euros.

Sin profundizar en los cálculos, el sentido del post es el de demostrar la posibilidad de implementar mediante SmartArt un árbol de decisión.

Por cierto, este post es el último del mes de Agosto, en breve me voy de vacaciones y estaré unos días desconectado 🙂 Nos vemos en Septiembre!!

Descarga el archivo de ejemplo pulsando en: CREAR ÁRBOL DE DECISIÓN CON SMARTART Y VBA

OBTENER NOMBRE E ID DE LOS DISEÑOS, COLORES Y ESTILOS RÁPIDOS DE SMARTART PARA VBA

Hace unos meses escribí un post acerca de las grandes posibilidades que ofrece el uso de SmartArt en vba: GENERAR ORGANIGRAMA EN SMARTART CON VBA EN EXCEL

Sin embargo y dado que estoy trabajando actualmente con otra entrada relacionada con esta temática, creo que es necesario hacer un post sobre los nombres y los ID de los diseños, los colores y los estilos rápidos que solemos utilizar en SmarArt y que son fundamentales para realizar un buen trabajo.

En la macro del post de los organigramas veíamos varias líneas de código que hacían referencia por un lado al DISEÑO:

Application.SmartArtLayouts("urn:microsoft.com/office/officeart/2008/layout/NameandTitleOrganizationalChart")

Por ejemplo, este hace referencia a un Organigrama con Título y Nombre, y hacemos referencia a su ID: "urn:microsoft.com/office/officeart/2008/layout/NameandTitleOrganizationalChart"

Pero también podríamos usar su código, que en Excel 2016 es el 89 y su nombre es Organigrama con Nombres y Puestos. Es decir que en Excel 2016 funcionaría perfectamente también así: Application.SmartArtLayouts(89)

Efectivamente, el ID siempre será el mismo en todas las versiones, mientras que el nombre (número clave) cambiará según versión. Por ese motivo siempre es más recomendable usar el ID que el nombre (a no ser que tengamos la certeza que todos los equipos en los que se ejecutará el código tengan la misma versión de Excel).

Con los colores y con los estilos rápidos sucede lo mismo, por ejemplo:

Colores:
Shape.SmartArt.Color = Application.SmartArtColors("urn:microsoft.com/office/officeart/2005/8/colors/accent0_1") 
y que podemos hacer referencia al nombre y en 2016 sería Contorno Oscuro 1 el 1, es decir: Shape.SmartArt.Color = Application.SmartArtColors(1)

Diseño Rápido:
Shape.SmartArt.QuickStyle = Application.SmartArtQuickStyles("urn:microsoft.com/office/officeart/2005/8/quickstyle/simple3") que se correspondería con el nombre Efecto Sutil código 1, y por lo tanto nos valdría poner: Shape.SmartArt.QuickStyle =Application.SmartArtQuickStyles(3)

Una vez comentado esto, os dejo una macro con la que podemos obtener tanto los nombres con los ID de cada uno de los elementos que hemos visto. De esta forma podréis obtener esta información para la versión con la que vayáis a trabajar. Este sería el código para los ID:

Sub SMARTART_ID()
Dim i As Double
With Sheets(2)
Fin = Application.CountA(.Range("A:A"))
If Fin > 0 Then Range("A1:C" & Fin).ClearContents
'Obtenemos los id de todos los diseños
Layaut = Application.SmartArtLayouts.Count
For i = 1 To Layaut
.Cells(1, 1) = "DISEÑO"
.Cells(i + 1, 1) = i & ": " & Application.SmartArtLayouts(i).ID
Next
'Obtenemos los ID de todos los colores
Colors = Application.SmartArtColors.Count
For i = 1 To Colors
.Cells(1, 2) = "COLORES"
.Cells(i + 1, 2) = i & ": " & Application.SmartArtColors(i).ID
Next
'Obtenemos el ID de todos los estilos rápidos
Styles = Application.SmartArtQuickStyles.Count
For i = 1 To Styles
.Cells(1, 3) = "ESTILOS RÁPIDOS"
.Cells(i + 1, 3) = i & ": " & Application.SmartArtQuickStyles(i).ID
Next
End With
End Sub

Para obtener los nombre solo es necesario sustituir la palabra .ID por .Name. De todas formas os dejo las dos macros en el archivo adjunto. Una vez que ejecutéis cada botón, se mostrará toda la información, en la pestaña 1 los Nombres (con su clave) y en la 2 los ID.

Listado con los ID:

OBTENER NOMBRE E ID DE LOS DISEÑOS, COLORES Y ESTILOS RAPIDOS DE SMARTART PARA VBA

Listado con el código y el nombre:

OBTENER NOMBRE E ID DE LOS DISEÑOS, COLORES Y ESTILOS RAPIDOS DE SMARTART PARA VBA1

Como siempre, espero que os sea de utilidad 🙂

Descarga el archivo de ejemplo pulsando en: OBTENER NOMBRE E ID DE LOS DISEÑOS, COLORES Y ESTILOS RÁPIDOS DE SMARTART PARA VBA