EXCELPATAS

Archivo de Excel que se elimina a sí mismo

2011-09-07T18:13:00.000-07:00

Hace poco, hugotron, un usuario del foro de mundoexcel, preguntó allí (Archivo suicida) por la posibilidad de lograr que un archivo se elimine a sí mismo. El tema fue cerrado con una única respuesta, por parte del mismo hugotron. La respuesta no es muy alentadora:

Bueno, contestando a mi propia pregunta, no es posible que un archivo sea eliminado por una macro contenida en el propio archivo.

La lógica es la siguiente, todo el código que se ejecuta desde el Módulo de un archivo deja de ejecutarse cuando el archivo es cerrado, y un archivo abierto no puede ser eliminado, así que al incluir cualquier línea de código VBA después de una línea que cierre el archivo desde el cual se está ejecutando una macro, resultará en la interrupción automática e inmediata del código.

La respuesta parace ser la correcta, pero esto no quiere decir que no se pueda encontrar una solución alternativa.

Mis primeras ideas pasaron por enviar comandos a la consola de comandos. Hice algunas pruebas con el comando "at", que permite programar tareas a horas especificadas. Sin embargo, los resultados no fueron los esperados.

Otra idea que no probé podría ser la de tener un libro alternativo con una macro que se ejecute con "ontime" pasados unos segundos después de cerrar el archivo que se quiere eliminar y lo elimine. Sin embargo, esto puede resultar un poco más complicado que la solución que planteo, que me parece es eficiente y sencilla.

Como bien lo dice hugotron, "no es posible que un archivo sea eliminado por una macro contenida en el propio archivo". Esto no quiere decir que no podamos eliminarlos desde otro lado, como otro libro o, en este caso, un VBScript que se crea en tiempo de ejecución dentro de la misma macro, se ejecuta, espera a que el libro se cierre y lo borra. El código, ampliamente comentado, es el siguiente:

'  El siguiente procedimiento crea un archivo .vbs que
'  se ejecuta antes de cerrar el libro.
'  Dicho script, una vez ejecutado, espera el tiempo indicado
'  en la constante TIEMPO_ESPERA_CIERRE_ARCHIVO_SEG para luego
'  pasar a eliminar el archivo una vez se encuentre cerrado.
'  Al final siempre quedará como residuo el vbScript que sólo
'  contiene tres líneas de código y el archivo que contenga 
'  este código se habrá borrado.

'  Creado por: Mauricio Robayo, AKA mjrofra
'  http://excelpatas.blogspot.com/2011/09/archivo-que-se-elimina-si-mismo.html
'  7 de septiembre de 2011

Sub Matarme_con_VBscript()


    '  Variable que almacena la ruta y el nombre
    '  del archivo .vbs que va a borrar este archivo.
    Dim VBScript As String
    
    
    '  Tiempo, en segundos, que se va a dar de
    '  espera mientras se cierra el archivo.
    '  Es necesario dar un tiempo de espera para
    '  asegurarse de que el archivo ha sido cerrado.
    '  Si el script se ejecuta con el archivo
    '  abierto, no se podrá borrar el archivo.
    '  En este caso, el tiempo de espera es de 2 segundos.
    Const TIEMPO_ESPERA_CIERRE_ARCHIVO_SEG = 2
    
    
    '  Si el archivo ha sido grabado por el usuario, tendrá una ruta.
    '  De lo contrario, la ruta se encontrará vacia y no será
    '  necesario borrar el archivo depués de cerrarlo pues ya
    '  no existirá.
    If ThisWorkbook.Path <> vbNullString Then
    
    
    
        '  Almacena la ruta y el nombre que se la va a dar al script.
        '  En este caso se usa la carpeta temporales, para evitar
        '  dejar rastros evidentes:
        VBScript = VBA.Environ$("Temp") & Application.PathSeparator & "MatarLibro.vbs"
    
    
    
        '  Crea el VBScript para borrar este archivo
        Open VBScript For Output As #1
        
        Print #1, "Set obj = CreateObject(""Scripting.FileSystemObject"")"
        Print #1, "WScript.sleep " & TIEMPO_ESPERA_CIERRE_ARCHIVO_SEG * 1000
        Print #1, "obj.DeleteFile """ & ThisWorkbook.FullName & """"
        
        Close #1

        
        
        '  Ejecuta el VBScript para borrar este archivo
        Shell "cmd /c " & VBScript

    
    End If
    
    
    
    '  Cierra el libro sin guardar cambios.
    ThisWorkbook.Close False
    


End Sub

Esta macro deberá ser llamada cuando se quiera borrar el archivo que la contiene. La macro creará un archivo vbscript (.vbs) que se ejecutará inmediatamente, esperará unos segundos (los que se le indiquen) a que cierre el archivo y luego pasará a eliminarlo sin dejar rastro.

Diagrama de caja y bigotes (box and whisker) en Excel II

2011-08-17T20:56:00.000-07:00

Antes que nada agradecer a quienes participaron en la primera publicación de Diagrama de caja y bigotes con Excel.

En la primera versión, Diagrama de caja y bigotes (box and whisker) en Excel, algunos lectores a quienes les agradezco, se tomaron el tiempo de descargar y probar el archivo. Dos errores fueron reportados:

Error I:

Hola, me he descargado el archivo, que tiene muy buena pinta, le he dado al botón y me ha salido un mensaje de Visual Basic de Error de compilación en
---------------------------
Microsoft Visual Basic
---------------------------
Error de compilación:

No se puede encontrar el proyecto o la biblioteca

y en color azul esta linea del código:
ReDim arrdatos(1 To lngVariables) As Variant

Y antes, en amarillo:
Public Sub CrearBoxPlot(ByRef Datos As Excel.Range, _
ByVal Encabezados As Boolean, _
ByVal FactorRIC As Double, _
ByVal Atipicos As Boolean, _
ByVal Mediana As Boolean, _
ByVal Media As Boolean)

Error II:

Aparece un error "1004" de depuración al tratar de generar el diagrama de cajas y bigotes con una sola serie de datos, es decir al tomar solamente una columna. Espero mi estimado que tome en cuenta esto. Nuevamente gracias por el aporte.

Creo poder afirmar que ambos errores se solucionan en esta nueva versión. Todo el código, como siempre, es abierto.

Agradezco una vez más cualquier comentario reportando cualquier otro error que pueda aparecer.

El archivo puede ser descargado acá: Diagramas_de_Caja2.xls

Aunque últimamente he tenido abandonado el blog pues no he tenido mucho tiempo, espero pronto poder subir ya una versión inicial para descargar como complemento, de manera gratuita y con el código disponible.

Ordenar las hojas de un libro de Excel

2011-02-13T15:57:00.000-08:00

Es frecuente encontrarse con libros llenos de hojas cuyos nombres corresponden a números. También es frecuente encontrarse con libros que tienen las pestañas de sus hojas de distintos colores. En el primer de los casos, por lo general buscamos tener las hojas ordenadas. En el segundo, buscamos tener las hojas agrupadas por color. Las macros que se presentan a continuación permiten hacer esto fácilmente.

Para ordenar hojas numeradas se puede usar una macro como esta, que se basa en el algoritmo de ordenamiento burbuja (buble sort). No he probado la macro exhaustivamente, pero parece arrojar buenos resultados (tenga en cuenta que las hojas con nombres no numéricos serán tratados por la macro como de valor 0 (cero). Si desea excluir una o varias hojas de la ordenación, haga uso de los argumentos Desde y Hasta como se indica más adelante) :

Public Sub OrdenarHojas(ByVal Desde As Long, ByVal Hasta As Long)


    Dim i As Long
    Dim j As Long
    
    
    For i = Desde To Hasta - 1
    
        For j = i + 1 To Hasta
            
            If VBA.Val(Sheets(i).Name) > VBA.Val(Sheets(j).Name) Then
                
                Sheets(j).Move before:=Sheets(i)
                
            End If
            
        Next j
    
    Next i
    
    
End Sub

Para agrupar las hojas por el color de sus pestañas, pruebe con esta macro:

Public Sub AgruparColorHojas(ByVal Desde As Long, ByVal Hasta As Long)

    
    Dim i As Long
    Dim j As Long
    
    
    For i = Desde To Hasta
    
        For j = i + 1 To Hasta
        
            If Sheets(i).Tab.ColorIndex = Sheets(j).Tab.ColorIndex Then
                
                Sheets(j).Move after:=Sheets(i)
                
            End If
    
        Next j
    
    Next i
    

End Sub

Puede llamar las macros indicando de qué hoja a qué hoja quiere ordenar o agrupar, por ejemplo, para agrupar todas las hojas de un libro, podría usar algo así:

Sub prueba()
    
    
    Application.ScreenUpdating = False
    
    OrdenarHojas Desde:=1, Hasta:=Sheets.Count
    
    Application.ScreenUpdating = True
    
    
End Sub

Observe que estoy desactivando la actualización de pantalla antes de pasar a ordenar las hojas, ya que el procedimiento OrdenarHojas, al ir moviendo las hojas de una posición a otra, puede ser lento y si no se desactiva la actualización de pantalla se notará cómo se van cambiando de posición las hojas.

Tenga en cuenta que puede combinar ambas macros para lograr resultados combinados. Suponiendo que tiene hojas con nombres numéricos y con colores, y desea tanto ordenarlas como agruparlas, podría probar con:

Sub prueba()
    
    
    Application.ScreenUpdating = False
    
    OrdenarHojas Desde:=1, Hasta:=Sheets.Count
    AgruparColorHojas Desde:=1, Hasta:=Sheets.Count
    
    Application.ScreenUpdating = True
    
    
End Sub

Esto dará como resultado las hojas agrupadas por color y ordenadas para cada color.

También observe que puede ordenar sólo un rango de hojas, suponiendo que no quiere ordenar o agrupar las dos primeras hojas, podría probar con:

Sub prueba()
    
    
    Application.ScreenUpdating = False
    
    OrdenarHojas Desde:=3, Hasta:=Sheets.Count
    
    Application.ScreenUpdating = True
    
    
End Sub

Al usar Sheets.Count se está indicando que se ejecute hasta el total de hojas en el libro activo. Si, por ejemplo, quisiera ordenar todas las hojas sin incluir la última, podría usar:

Sub prueba()
    
    
    Application.ScreenUpdating = False
    
    OrdenarHojas Desde:=1, Hasta:=Sheets.Count - 1
    
    Application.ScreenUpdating = True
    
    
End Sub

Con una ligera modificación se puede usar la macro OrdenarHojas para que ordene hojas con nombres no numéricos, por ejemplo: "C", "D", "A", que pasaría a ser "A", "C", "D" tras ejecutar la macro:

Public Sub OrdenarHojas(ByVal Desde As Long, ByVal Hasta As Long)


    Dim i As Long
    Dim j As Long


    For i = Desde To Hasta - 1

        For j = i + 1 To Hasta

            If Sheets(i).Name > Sheets(j).Name Then

                Sheets(j).Move before:=Sheets(i)

            End If

        Next j

    Next i


End Sub

Diagrama de caja y bigotes (box and whisker) en Excel

2011-01-16T16:09:00.000-08:00

Es fácil encontrar en la red algunos tutoriales para realizar en Excel diagramas de caja y bigotes (que de ahora en adelante llamaré simplemente diagramas de caja o boxplot).

Sin embargo, la gran mayoría de los tutoriales que se encuentran, tanto en inglés como en español, explican como hacer un diagrama de caja usando los máximos y los mínimos. No he encontrado ninguno que explique cómo realizar un diagráma de caja que se base en el rango intercuartílico y que además explique como trazar los datos atípicos.

Por ello, he estado trabajando en el código para crear en Excel un diagrama de caja con todas las de la ley. Espero terminar de depurar pronto y subirlo como un complemento, sin restricciones para consultar o modificar el código y de uso gratuito (al parecer, todas las utilidades que se encuentran en la red para graficar Boxplots de manera profesional tiene costo. Quizás el más popular sea el PTS Box and Whisker Chart Utility de Jon Peltier).

Para entender los parametros predeterminados que he puesto en el formulario, es necesario entender cómo se grafica un diagrama de caja:

La caja cubre el 50% de los datos, siendo su parte superior el cuartil 1 (Q1) y la parte inferior el cuartil 3 (Q3).
La caja presenta un línea en la mitad que corresponde al cuartil 2 o mediana y permite identificar facilmente si existe sesgo en los datos.
Los bigotes (whiskers) muestran los valores máximos y mínimos, a menos que hayan datos atípicos, que son aquellos que están más allá de 1.5 veces el rango intercualtílico (Q3 - Q1).
En caso de existir atípicos, los bigotes corresponder al dato más cercano a 1.5 veces el rango intercuartílico y los datos atípicos se presentan como puntos más allá de los bigotes.
Se puede graficar la media como un diamante en la caja.

El archivo contiene un formulario, tras cargarlo, el formulario permite configurar las características que queramos para el diagrama de caja. Por defecto, se mostrará el diagrama de caja como se explicó anteriormente, pero sin incluir el diamante para la media. Si se quiere ver la media, basta con seleccionarla en el formulario.

He contrastado el resultado producido con Excel por el producido con R (http://www.r-project.org/). El siguiente es el gráfico arrojado por R y el arrojado por Excel (usando el motor gráfico de Excel 2003).

Al parecer, el resultad obtenido con el código en Excel es bastante preciso. Sin embargo, antes de afirmar que el código funciona correctamente, agradezco a quien pueda descargar el archivo y hacer algunas pruebas con él, para identificar errores y publicarlos en los comentarios. Yo continuaré en la tarea de depurar el código para dejar el complemento listo para usar.

Gracias a todos los que participaron en la sección de comentarios. He publicado una nueva entrada con la última versión en la que se da solución (espero) a los errores reportados: Diagrama de caja y bigotes con Excel II .

Copiar valores y conservar el formato dado mediante formato condicional

2011-01-13T11:55:00.000-08:00

La siguiente macro permite copiar como valores todas las fórmulas en las celdas que usan formato condicional, permitiendo además conservar el formato dado por medio de formato condicional, pero ahora de manera estática, simplemente como formato de celda.

La macro se basa en un truco publicado por "sagrat" en el foro de Ayuda Excel: Pegar color del formato condicional.

Sagrat menciona que se puede copiar el rango de datos con formato condicional a Word y luego copiarlo de vuelta a Excel, lo que hace que el formato dado por el formato condicional quede como formato de celda.

La macro, que se basa en este truco, crea una instancia invisible de Word y pasa a copiar a Word e inmediatamente a copiar de vuelta a Excel las celdas con formato condicional de cada una de las hojas del libro activo. Esto tiene 3 efectos:

Convierte todas las fórmulas de las celdas con formato condicional de cada hoja del libro activo a valores;
Convierte el formato condicional de todas las celdas con formato condicional de cada hoja del libro activo a formato de celda;
Usa la precisión visible en la celda. Es decir, si la celda con formato condicional tiene formato para mostrar dos decimales, pero el valor en la celda tiene más de dos decimales, tras ejecutar la macro, el valor resultante sólo tendrá los dos decimales visibles, perdiéndose los demás.

Sub BorrarFormatoCondicional_LibroActivo()


    Dim WordApp As Object
    Dim wsHoja As Excel.Worksheet
    Dim rngArea As Excel.Range
    Dim rngCeldasFormatoCondicional As Excel.Range
    
    
    On Error GoTo err_BorrarFormatoCondicional
    
    
    With Application
        .ScreenUpdating = False
        .StatusBar = "Creando instancia de Word..."
    End With
    
    
    Set WordApp = CreateObject("Word.Application")
    
    
    For Each wsHoja In ActiveWorkbook.Worksheets
    

        Set rngCeldasFormatoCondicional = wsHoja.UsedRange.SpecialCells(xlCellTypeAllFormatConditions)

    
        If Not rngCeldasFormatoCondicional Is Nothing Then
        
            wsHoja.Select
    
            For Each rngArea In rngCeldasFormatoCondicional.Areas
        
                With rngArea
                    .Select
                    .Copy
                End With
                
                With WordApp
                    .documents.Add
                    With .Selection
                        .PasteSpecial
                        .wholestory
                        .Copy
                        .Delete
                    End With
                End With

                wsHoja.PasteSpecial "HTML"
                
            Next rngArea
              
        End If
        
    Next wsHoja
    
    
Salir:
    
    If Not WordApp Is Nothing Then
        WordApp.Quit False
        Set WordApp = Nothing
    End If
    
    With Application
        .StatusBar = False
        .ScreenUpdating = True
    End With
    
    Exit Sub
    
    
err_BorrarFormatoCondicional:
    
    If Err.Number = 1004 Then
        Resume Next
    Else
        MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, Err.Source
        Resume Salir
    End If
    
    
End Sub

Si sólo se desea copiar uno o varios rangos de una hoja, se puede probar de la siguiente forma, seleccionando cuando la macro lo pida los rangos en cuestión:

Sub BorrarFormatoCondicional_Seleccion()


    Dim WordApp As Object
    Dim rngTrabajo As Excel.Range
    Dim rngArea As Excel.Range
    Dim rngCeldasFormatoCondicional As Excel.Range
    
    
    On Error GoTo err_BorrarFormatoCondicional
    

    Set rngTrabajo = Application.InputBox(Prompt:="Por favor, seleccione el rango de celdas con el que desea trabajar.", _
                                          Title:="Fijar formato condicional", _
                                          Type:=8)
                                       
    Application.ScreenUpdating = False
    
    Set rngCeldasFormatoCondicional = rngTrabajo.SpecialCells(xlCellTypeAllFormatConditions)

    If Not rngCeldasFormatoCondicional Is Nothing Then
                      
        Set WordApp = CreateObject("Word.Application")
        
        For Each rngArea In rngCeldasFormatoCondicional.Areas
    
            With rngArea
                .Select
                .Copy
            End With
            
            With WordApp
                .documents.Add
                With .Selection
                    .PasteSpecial
                    .wholestory
                    .Copy
                    .Delete
                End With
            End With

            Selection.Parent.PasteSpecial "HTML"

        Next rngArea
                    
        Set rngCeldasFormatoCondicional = Nothing
        
    End If
        
    
    
Salir:
    
    If Not WordApp Is Nothing Then
        WordApp.Quit False
        Set WordApp = Nothing
    End If
    
    Application.ScreenUpdating = True
    
    Exit Sub
    
    
err_BorrarFormatoCondicional:
    
    If Err.Number <> 424 Then
        MsgBox "Error " & Err.Number & ": " & Err.Description, vbInformation, Err.Source
    End If
    
    Resume Salir
    
End Sub

¿Qué es un arreglo en programación?

2011-01-06T19:07:00.000-08:00

El uso de la palabra arreglo en programación como traducción de la palabra array se ha difundido ampliamente. Desafortunadamente, esto no es más que una pésima y lastimosa traducción que no corresponde en significado con el original en inglés.

Al parecer, algunos traductores que no supieron cómo volcar al español la palabra inglesa array, decidieron, por similitud fonética (pero sin ninguna similitud semántica) usar la palabra arreglo. Gracias a ese pésimo trabajo de traducción (y descuidado trabajo de edición), se ha difundido su uso sin que esto quiera decir que sea correcto.

La palabra arreglo no guarda ninguna equivalencia semántica con la inglesa array. Quizás una traducción más cercana, aunque no precisa, pudiera ser conjunto.

En su sexta acepción, según el Diccionario de la Lengua Española de la Real Academía, conjunto se define como:

Totalidad de los elementos o cosas poseedores de una propiedad común, que los distingue de otros; p. ej., los números pares.

Sin embargo, conjunto suena demasiado simple como traducción de array y parece que a muchos no nos gusta recurrir a lo simple cuando nos expresamos, sino que preferimos usar términos oscuros que impresionen y confundan a nuestra audiencia, así sean un disparate completo en el contexto en el que los usamos.

Quizás lo mejor sea conservar la palabra array como se conserva la palabra software o hardware a falta de una palabra en español que las reemplace, pero no atropellar al español traduciéndola como arreglo.

Las palabras software y hardware ya han sido incorporadas como anglicismos al idioma español. Quizás pronto se incorpore la palabra array como otro anglicismo, aunque como vamos, los académicos de nuestra lengua van a tener que crear una nueva acepción para la palabra arreglo.

Mientras tanto, puede usted mismo consultar en el Diccionario de la Lengua Española el significado de arreglo, para que trate de descifrar según sus distintas acepciones qué es lo que alguien quiere decir cuando se refiere, por ejemplo, a un arreglo de enteros:

1. m. Acción y efecto de arreglar.
2. m. Regla, orden, coordinación.
3. m. Avenencia, conciliación.
4. m. Transformación de una obra musical para poder interpretarla con instrumentos o voces distintos a los originales.
5. m. coloq. amancebamiento.
~ de cuentas.
1. m. Acto de tomarse la justicia por su mano o vengarse.
~ parroquial.
1. m. Reforma de las categorías y demarcaciones de las parroquias de una diócesis.
con ~ a.
1. loc. prepos. Conformemente con, según.

Borrar todas los vínculos (referencias) a otros archivos de Excel

2011-01-03T18:12:00.000-08:00

La siguiente macro elimina todos los vínculos (referencias) a otro archivo de Excel, dejando sólo el valor resultante:

Sub BorrarVinculosOtrosArchivos_XL()
    
    
    Dim lks As Variant
    Dim i As Long
    
    
    With ActiveWorkbook
        
        lks = .LinkSources(xlExcelLinks)
        
        If IsEmpty(lks) Then
        
            MsgBox "No hay vínculos para borrar."
            
        Else
        
            For i = LBound(lks) To UBound(lks)
                .BreakLink lks(i), xlExcelLinks
            Next i
            
        End If
        
    End With
    
    
End Sub

Convertir a valores todas las fórmulas de un libro de Excel

2010-12-27T09:15:00.000-08:00

La siguiente macro convierte a valores todos las fórmulas de todas las hojas de un libro, dejando sólo el resultado:

Sub Convertir_a_valores()


    Dim wshHoja As Excel.Worksheet
   

    For Each wshHoja In ThisWorkbook.Worksheets
   
        wshHoja.UsedRange.Value = wshHoja.UsedRange.Value     
   
    Next wshHoja


End Sub

Análisis técnico con Excel: Promedio móvil simple, exponencial y MACD

2010-12-24T18:22:00.000-08:00

En el siguiente archivo se presentan los cálculos correspondientes para obtener un promedio móvil simple y uno exponencial (no centrados), así como el MACD (convergencia / divergencia de promedios móviles).

De igual forma, se presenta el gráfico de velas japonesas con los indicadores para realizar el análisis de la acción del precio correspondiente. Para desarrollarlo he descargado datos de Yahoo Finance para Google Inc.

En las celdas amarillas se pueden modificar los parámetros para las medias y para el MACD (que se calcula a partir de dos promedios móviles exponenciales).

Análisis técnico.xls

Concatenar celdas en un rango de Excel

2010-12-20T09:07:00.000-08:00

La siguiente Función Definida por el Usuario (UDF) permite concatenar un rango de celdas en una fila o una columna en una sola celda con el separador que se le indique.

Este tipo de función resulta útil pues la función Concatenar de Excel no es muy flexible y no es muy práctica para este tipo de trabajo. Si se tienen, por ejemplo, 100 o más celdas en una columna y se quieren concatenar usando el punto y coma, no resultaría nada práctico usar algo como =Concatenar(a1,";",a2,";",a3, ... ";",a100).

Public Function Concat1(ByVal Rango As Excel.Range, ByVal Sep As String) As String
 
    Dim Datos As Variant
   
    Datos = Rango.Value
 
    If UBound(Datos, 1) > 1 Then
        Concat1 = VBA.Join(Application.Transpose(Datos), Sep)
    Else
        Concat1 = VBA.Join(Application.Index(Datos, 1, 0), Sep)
    End If
   
End Function

Para llamar a la UDF siga la sintaxis:

Concatenar(Rango, Sep)

En donde Rango es el rango de celdas y Sep es el separador que desea. Por ejemplo:

=Concatenar(a1:a100,";")

Tenga en cuenta que estoy usando la coma "," como separador de argumentos. Si su separador de argumentos es el punto y coma ";", entonces deberá usar algo como:

=Concatenar(a1:a100;";")

La UDF expuesta anteriormente es sencilla y cumple con su cometido, pero si se desea un poco más de control sobre el rango a concatenar, se podría probar algo así:

Public Function Concat2(ByVal Rango As Excel.Range, _
                        ByVal Sep As String, _
                        Optional ByVal Orden As Integer = 1, _
                        Optional ByVal PrioridadFilas As Boolean = True) As String
 
 
    Dim Datos As Variant
    Dim Fila As Long
    Dim Columna As Long
    Dim InicioFila As Long
    Dim InicioColumna As Long
    Dim FinFila As Long
    Dim FinColumna As Long
    
   
    Datos = Rango.Value
    
    
    If Orden > 0 Then 'Orden ascendente
    
        InicioFila = LBound(Datos, 1)
        InicioColumna = LBound(Datos, 2)
        FinFila = UBound(Datos, 1)
        FinColumna = UBound(Datos, 2)
    
    Else ' Orden descendente
    
        InicioFila = UBound(Datos, 1)
        InicioColumna = UBound(Datos, 2)
        FinFila = LBound(Datos, 1)
        FinColumna = LBound(Datos, 2)
    
    End If
    
     
    If PrioridadFilas Then '  Concatenar por filas
    
        For Fila = InicioFila To FinFila Step Orden
        
            For Columna = InicioColumna To FinColumna Step Orden
                
                Concat2 = Concat2 & Sep & Datos(Fila, Columna)
                    
            Next Columna
        
        Next Fila
    
    Else '  Concatenar por columnas
        
        For Columna = InicioColumna To FinColumna Step Orden
        
            For Fila = InicioFila To FinFila Step Orden
                
                Concat2 = Concat2 & Sep & Datos(Fila, Columna)
                    
            Next Fila
        
        Next Columna
    
    End If
    
    
    Concat2 = VBA.Replace(Concat2, Sep, "", 1, 1)
   
   
End Function

Este UDF tiene la siguiente sintaxis:

Concatenar(Rango, Sep, [Orden], [PrioridadFilas])

Los dos últimos argumentos que incluye de más esta UDF (Orden y PrioridadFilas) son opcionales e indican si se desea concatenar el rango en orden ascendente o descendente y, en caso de rangos de dos dimensiones, si se desea dar prioridad a las filas o a las columnas.

Si se omite el argumento orden, el valor predeterminado es 1 (orden ascendente). Para indicar orden descendente use -1.

Tenga en cuenta que cualquier valor positivo para este argumento indicará orden ascendente mientras que cualquier valor negativo indicará orden descendente. Si se ingresa 2 como valor para el argumento orden, se concatenará cada dos celdas del rango en orden ascendente, es decir, se concatenará el rango dejando una celda de por medio. Si se ingresa 3, se concatenará cada tres celdas del rango en orden ascendente, es decir dejando 2 celdas de por medio, etc. Exactamente lo mismo aplica para el orden descendente con valores negativos.

Finalmente, el argumento opcional PrioridadFilas se usará cuando se pretenda concatenar una matriz de dos dimensiones. Tenga en cuenta que la UDF propuesta inicialmente (Concat1) no acepta rangos de dos dimensiones (es decir, de más de una columna y más de una fila). Con Concat2 podrá pasar como argumento Rango un rango de dos dimensiones (más de una fila y una columna. Por ejemplo: A1:C3, siendo este un rango de 3 fila por 3 columnas). El valor predeterminado es Verdadero, indicando que se concatenará primero por filas y luego por columnas. Si se indica Falso ó 0 para este argumento, se concatenarán primero las columnas y luego las filas.

Si tiene dudas sobre cómo usar una UDF lea la sección "Para usar una Función Definida por el Usuario (FDU o UDF)" en el siguiente vínculo: ¿Qué hago con este código?

Simulación de Monte Carlo para estimar el valor de PI

2010-12-11T12:04:00.000-08:00

En el adjunto se presenta una simulación de Monte Carlo para estimar el valor de PI de acuerdo con el número de ensayos que se indique.

A su vez, se presenta tres gráficos animados.

El libro contiene pocas fórmulas pues casi todo está basado en código VBA.

En el siguiente vínculo puede descargar el archivo: Estimación de Pi mediante simulación de Monte Carlo.xls

Mostrar todas las fórmulas de uno o varios rangos

2010-11-25T20:54:00.000-08:00

El siguiente código permitirá crear una matriz mostrando la dirección, el valor y la fórmula de uno o varios rangos seleccionados. Recuerde que puede seleccionar rangos no continuos manteniendo presionado la tecla Ctrl mientras los selecciona.

He comentado ampliamente el código para que sea fácil seguirlo y modificarlo según necesidades particulares.

También le puede resultar de interés la función definida por el usuario que se encuentra en este otro tema: Mostrar fórmula en una celda.

Sub MatrizValoresFormulas()
        
        
    Dim i As Long
    Dim lngTotalCeldas As Long
    Dim bytContinuar As Byte
    Dim rngCelda As Excel.Range
    Dim rngEntrada As Excel.Range
    Dim rngSalida As Excel.Range
    Dim arrResultado() As Variant
    
    '  Control de errores
    On Error GoTo err_MatrizValoresFormulas
    
    '  Asigna el rango de entrada. Se pueden seleccionar rangos
    '  no continuos manteniendo presionada la tecla Ctrl
    Set rngEntrada = Application.InputBox(prompt:="Seleccione las celdas cuya fórmula desea ver:", _
                                          Title:="Inspección", _
                                          Type:=8)
    
    '  Asigna el rango de salida a partir de una celda seleccionada
    Set rngSalida = Application.InputBox(prompt:="Seleccione una celda de salida:", _
                                         Title:="Inspección", _
                                         Type:=8)
        
    lngTotalCeldas = rngEntrada.Cells.Count
    
    ReDim arrResultado(0 To lngTotalCeldas, 1 To 3)
    
    '  Encabezados
    arrResultado(0, 1) = "Celda"
    arrResultado(0, 2) = "Valor"
    arrResultado(0, 3) = "Fórmula"
    
    '  Se construye la matriz con la dirección, el valor
    '  y la fórmula de cada celda del rango seleccionado
    For Each rngCelda In rngEntrada.Cells
        i = i + 1
        With rngCelda
        
            '  Dirección:
            '  RowAbsolute y ColumnAbsolute: Usar True para ref Absolutas ($A$1) y False para relativas (A1)
            '  ReferenceStyle: Usar xlA1 para ref tipo A1 y xlR1C1 para referencias tipo R1C1
            '  External: Usar True para mostrar la referencia completa (incluida la hoja y el libro) y False
            '            para mostrar solo la dirección de la celda
            arrResultado(i, 1) = .Address(RowAbsolute:=True, _
                                          ColumnAbsolute:=True, _
                                          ReferenceStyle:=xlA1, _
                                          External:=True)
                                          
            '  Valor
            arrResultado(i, 2) = .Value
            
            '  Fórmula de la celda
            If .HasFormula Then
                '  Si la celda tiene fórmula
                If .HasArray Then
                    '  Si es matricial encierra la fórmula entre {}
                    arrResultado(i, 3) = "{" & .FormulaLocal & "}"
                Else
                    '  De lo contrario, copia la fórmula
                    arrResultado(i, 3) = "'" & .FormulaLocal
                End If
            Else
                '  Si la celda no tiene fórmula devuelve #N/A
                arrResultado(i, 3) = VBA.CVErr(xlErrNA)
            End If
            
        End With
        
    Next rngCelda
    
    With rngSalida.Areas(1)
    
        bytContinuar = vbYes

        '  Verifica que no se vayan a borrar datos existentes en el rango de salida
        With .Resize(lngTotalCeldas + 1, 3)
            If Application.WorksheetFunction.CountA(.Cells) Then
                bytContinuar = VBA.MsgBox(prompt:="Esta operación borrará datos existentes en el rango de salida." _
                                                  & vbNewLine & vbNewLine & _
                                                  "¿Desea continuar?", _
                                          Buttons:=vbYesNo + vbQuestion, _
                                          Title:="Inspección")
            End If
            
            '  Se imprimen los resultado en el rango de salida
            If bytContinuar = vbYes Then
                .ClearFormats
                .Rows(1).Font.Bold = True
                .Value = arrResultado
            End If
            
        End With
          
    End With
    
    
Salir:
    Set rngSalida = Nothing
    Set rngEntrada = Nothing
    Erase arrResultado
    Exit Sub
    
err_MatrizValoresFormulas:
    Select Case Err.Number
        Case 424  '  Se canceló alguno de los inputbox
        'Case ...
        Case Else
            MsgBox "Error " & ": " & Err.Description, vbCritical, Err.Source
    End Select
    Resume Salir

End Sub

Prueba de normalidad en Excel

2010-11-03T10:09:00.000-07:00

El siquiente archivo permite ingresar cualquier conjunto de datos (pooco más de 65000 en Excel 2003 y anteriores y poco más de un millón si se convierte el archivo a .xlsx).

Lo único que hay que hacer es ingresar los datos a partir de A2 y el archivo hace el resto.

También es posible escoger el número de grupos para trazar el histograma (desde 5 hasta 20 grupos).

Los datos para los gráficos se encuentran en nombres definidos, lo que permite ahorrar espacio pues no se usan celdas para calculos.

El único problema que se puede presentar es con los gráficos, que se congelen o que no grafiquen todos los puntos (me parece que son 32.000 puntos por serie y me parece haber leído que para Excel 2010 se aumentó él limite al númer de filas, esto es un poco más de un millón. En todo caso no estoy seguro de esta información).

Prueba de normalidad.xls

El archivo fue creado originalmente para el foro de Ayuda Excel, en este tema: test de normalidad

Desplazarse rápidamente por las hojas de un libro de Excel

2010-06-22T21:52:00.000-07:00

Con frecuencia nos encontramos con libros que tienen muchas hojas y queremos desplazarnos rápidamente por ellas. En el siguiente vídeo se presentan algunas formas de hacerlo.

Si quiere usar un botón o un atajo del teclado para llamar al menú que se activa cuando da clic derecho sobre las flechas para desplazarse por las hojas en la parte inferior izquierda de la hoja, puede usar esta macro:

Sub MenúHojas()

    With Application.CommandBars("Workbook Tabs").Controls(16)
    
        If VBA.Right(.Caption, 3) = "..." Then
            .Execute
        Else
            .Parent.ShowPopup
        End If
        
    End With

End Sub

Cambiar el registro por medio de VBA - Options6: Color de la selección

2010-06-16T19:20:00.000-07:00

En Cambiar el color predeterminado de la selección en una hoja de Excel vimos como modificar el registro para cambiar el color de la selección en una hoja de Excel. Existen también algunas alternativas para modificar el registro por medio de VBA. La más usada es por medio de llamadas API, como se describe en el sitio de Chip Pearson: http://www.cpearson.com/excel/Registry.htm

Otra forma de hacerlo, a mi parecer un poco más sencilla, es por medio de un objeto WScript.Shell. Los métodos que soporta un objeto WScript.Shell para modificar el registro son:

Para este caso en específico, vamos a usar los métodos RegRead y RegWrite. Usamos RegRead para leer el valor de Options6 en la ruta especificada del registro y RegWrite para escribir el nuevo valor.

La macro modificará el valor de Options6 y luego reiniciará Excel para que se hagan efectivos los cambios. Por esto, cierre cualquier libro de Excel en el que esté trabajando, abra un libro nuevo y vaya al editor de VB, allí inserte un nuevo módulo, copie la macro y ejecútela.

También puede descargar este archivo con la macro lista para utilizar: Cambiar el color predeterminado de la selección.xls

Sub Cambiar_Color_Selec()


    Dim Options6 As String
    Dim Valor As Byte
    Dim oShell As Object


    Options6 = "HKEY_CURRENT_USER\Software\Microsoft\Office\" & Application.Version & "\Excel\Options\Options6"
    

    Set oShell = CreateObject("WScript.Shell")
    
    
    On Error Resume Next
    Valor = oShell.RegRead(Options6)
    On Error GoTo 0
    

    Valor = VBA.IIf(Valor = 16, 0, 16)
    

    oShell.RegWrite Options6, Valor, "REG_DWORD"
        
    If MsgBox(prompt:="Se ha modificado exitosamente el registro." & vbLf & vbLf & _
                      "¿Desea reiniciar Excel para terminar el proceso?" & vbLf & vbLf & _
                      "Tenga en cuenta que se cerrarán todos los libros abiertos" & vbLf & _
                      "y no se guardará ningún cambio que haya realizado.", _
              Buttons:=vbYesNo + vbQuestion, _
              Title:="Registro modificado") = vbYes Then
              
        With CreateObject("Excel.Application")
            .Workbooks.Add
            .Visible = True
        End With
        
        With Application
            .DisplayAlerts = False
            .Quit
        End With
        
    Else
    
        MsgBox prompt:="Recuerde que el cambio se hará efectivo" & vbLf & _
                       "una vez reinicie Excel.", _
               Buttons:=vbInformation, _
               Title:="Registro modificado"
    
    End If
    
    
    Set oShell = Nothing
    
        
End Sub

¡IMPORTANTE! Antes de modificar el registro asegúrese de crear una copia. Modificar el registro de Windows puede crear graves problemas si no se sabe exactamente qué es lo que está haciendo. La macro la he probado con Excel 2000, 2003 y 2007, y no me ha presentado ningún problema y funciona correctamente, pero no por ello puedo responder por cualquier otro cambio que usted haga del registro o por un uso indebido de la macro. Modifique el registro bajo su propia responsabilidad.

Cambiar el color predeterminado de la selección en una hoja de Excel

2010-06-14T14:13:00.000-07:00

Antes que nada, advertir que este truco implica modificar las opciones de Excel direcctamente en el registro, lo cual, si no se hace con cuidado, puede traer serios problemas. Por esto mismo, siempre es recomendable hacer una copia del registro antes de efectuar cualquier modificación.

Este truco ha sido publicado por John Walkenbach en su libro Excel 2007 Power Programming with VBA.

En la sección Manuales Excel y VBA encuentra un vínculo en el que puede leer gran parte de ese libro de manera gratuita, a través de Google Libros.

Dicho esto, nos remangamos la camisa y hacemos lo siguiente:

1-. Cierre Excel.

2-. Vaya a Inicio y seleccione "Ejecutar...".

3-. Allí escriba "Regedit" para abrir el Editor del Registro y seleccione "Aceptar".

4-. En el Editor del Registro vaya a la siguiente carpeta

Excel 2003: HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Excel\Options
Excel 2007: HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Excel\Options

5-. En la columna "Nombre" busque "Options6", si no lo encuentra, sobre la carpeta "Options", con el botón derecho del ratón seleccione "Nuevo..." > "Valor de DWORD" y dele el nombre "Options6".

6-. Con el botón derecho del ratón sobre "Options6" seleccione "Modificar" y en el cuadro de diálogo que se abre, seleccione "Decimal" e ingrese el valor 16 y presione "Aceptar".

7-. Cierre el Editor del Registro y abra Excel. El color de fondo de la selección ahora deberá ser negro.

Ahora, si lo que en realidad le interesa es resaltar de alguna manera la selección o la fila de una celda seleccionada, revise este otro tema: Resaltar la fila de la celda seleccionada.

Si le interesa saber cómo modificar el registro por medio de VBA, consulte este artículo: Cambiar el registro por medio de VBA - Options6: Color de la selección.

Encontrar el último dato ingresado para un caso en particular

2010-06-12T00:45:00.000-07:00

En el siguiente vídeo se explica cómo encontrar el último valor que se haya registrado para un dato en particular en un conjunto de datos. Para hacerlo, hemos hecho uso de una fórmula que ha sido ampliamente difundida por Internet pero cuyo funcionamiento puede resultar un poco oscuro. El vídeo, más que simplemente exponer la fórmula, busca explicar su funcionamiento.

La fórmula hace uso de la función BUSCAR, si desea entender un poco más sobre esta función y comprender cómo nos ayuda en este caso, revise este tema: Encontrar el último valor en un conjunto de datos: Búsqueda binaria.

También puede que le ayude a comprender un poco mejor algunos de los mecanismos utilizados en la fórmula el siguiente tema: Coaccionar valores en una fórmula II: Valores lógicos a valores numéricos.

Si usted conoce otro forma de llevar a cabo este procedimiento, no dude en compartirla en la sección de comentarios.

Coaccionar valores en una fórmula II: Valores lógicos a valores numéricos

2010-06-11T14:24:00.000-07:00

En la Parte I de este tema veíamos cómo Excel coacciona valores numéricos diferentes a 0 como VERDADERO y el 0 como FALSO cuando son introducidos en una fórmula que espera un argumento lógico. También es posible lograr lo contrario: coaccionar los valores lógicos VERDADERO y FALSO A valores numéricos.

Lo primero que hay que tener en cuenta es que Excel coacciona el valor lógico VERDADERO como 1 y el valor lógico FALSO como 0.

Podemos lograr esto de diferentes formas. Incluso, podemos usar la función N. Aunque el uso de la función N no caería en la categoría de coaccionar los valores. Al decir coaccionar, queremos decir que Excel 'obliga' a un valor tomar otro valor dentro del contexto esperado. Por esto, podemos decir que cuando usamos =Y(1), Excel coacciona el 1 como VERDADERO, pues dentro del contexto de la función Y(), el argumento que se la ha pasado es obligado a asumir la forma de un valor lógico.

En el caso de la función N, ésta convierte el valor que se le indique de acuerdo a unas reglas predefinidas, no está coaccionando el valor ingresado para que se comporte de acuerdo a un valor esperado. Así, al usar algo como:

=N(FALSO)

de acuerdo con la regla establecida por la función, ésta convierte el FALSO al valor numérico 0. Por otro lado, si usamos algo como:

=1*FALSO

estamos coaccionando (forzando) el valor lógico FALSO para que se comporte de acuerdo a un valor como lo esperaría el operador * (multiplicación). Por lo que el FALSO es coaccionado a 0.

Teniendo esto en consideración y continuando con los ejemplos para simplificar la función SI que veníamos exponiendo en la Parte I de este tema, podemos coaccionar los valores lógicos VERDADERO o FALSO para prescindir de la función SI.

Así, si quisiéramos que de acuerdo con una condición se devolviera un valor dado, por ejemplo, que cuando el valor en A1 sea igual a "Prueba" entonces devuelva 1 y de lo contrario devuelva 0, inicialmente podríamos usar algo así:

=SI(A1="Prueba";1;0)

pero también podríamos simplemente convertir por medio de la función N el valor lógico devuelto en la comparación A1="Prueba", así:

=N(A1="Prueba")

lo que dará 1 en el caso que A1 sea igual a Prueba y 0 en el caso contrario. Finalmente, también podríamos prescindir de cualquier función y simplemente coaccionar el valor lógico al introducirlo en un contexto en el cual se espera un valor numérico, por ejemplo:

=1*(A1="Prueba")

o también:

=0+(A1="Prueba")

o cualquier otra operación que obligue al valor lógico (VERDADERO o FALSO) a convertirse en un valor numérico (1 o 0).

Otra forma más de coaccionar el valor lógico arrojado por la función (y que quizás usted ya haya visto en alguna fórmula) es antecediéndolo de dos signos negativos (--).

En términos de rendimientos, quizás esta sea la forma más rápida de coaccionar valores lógicos a valores numéricos y quizás por eso mismo sea bastante frecuente encontrar este método.

Cuando antecedemos un signo negativo, estamos colocando el valor lógico en un contexto en el que espera un número, por ello es coaccionado a una número. Puede comprobar esto ingresando en una celda la siguiente fórmula:

=-VERDADERO

observará que el resultado es -1, pues el signo menos antecediendo al valor lógico VERDADERO que es coaccionado a 1 por Excel dará como resultado -1.

Como lo que en realidad queremos es un 1, no un menos 1, pues simplemente anteponemos otro signo negativo, que sería algo equivalente a multiplicar negativo por negativo lo cual sabemos que da positivo, por eso al ingresar:

=--VERDADERO

obtenemos 1. De esta forma, volviendo a la fórmula original, podríamos reemplazarla con:

=--(A1="Prueba")

lo que será coaccionado a 1 en caso de ser verdadero y a 0 en caso de ser FALSO, que es lo mismo que buscábamos inicialmente.

Continuará...

Eliminar datos con una característica determinada de una tabla de datos

2010-06-11T10:48:00.000-07:00

El siguiente vídeo muestra cómo eliminar datos de una tabla de datos, de acuerdo con una característica en específico, haciendo uso de autofiltros y del comando "Ir a". El atajo del teclado para activar / desactivar el autofiltro es Ctrl+Mayus+L (Ctrl+Shift+L). Puede que de acuerdo con la configuración del equipo la combinación de teclas cambie.

Se puede lograr lo mismo haciendo uso de una macro como esta:

Sub Eliminar_filas_cero()

    '  Desactiva la actulización de pantalla
    Application.ScreenUpdating = False

    '  Trabajar con todo el conjunto de datos a partir de
    '  A1 de la hoja "Hoja1"
    With Sheets("Hoja1").Range("a1").CurrentRegion
        
        '  Aplica el autofiltro al campo 3 con el criterio igual a 0
        .AutoFilter Field:=3, Criteria1:="0"
        
        '  Elimina las celdas visibles de los datos, excluyendo los
        '  encabezados
        .Offset(1).Resize(.Rows.Count - 1).SpecialCells(12).EntireRow.Delete
        
        '  Elimina el autofiltro
        .AutoFilter
        
    End With
    
    '  Activa la actualización de pantall
    Application.ScreenUpdating = True
    
End Sub

Coaccionar valores en una fórmula I: Valores numéricos a valores lógicos

2010-06-09T19:56:00.000-07:00

Por lo general, cuando usamos la función SI especificamos en ella una comparación con un operador lógico cuyo resultado evaluará VERDADERO o FALSO. Sin embargo, en algunos casos en concreto se puede omitir la comparación, aprovechando que Excel coacciona el cero como FALSO y cualquier otro valor numérico como VERDADERO cuando son introducidos en una función que espera un valor lógico.

Esto quiere decir que si ingresa el valor 0 en una función que espera un valor lógico (VERDADERO o FALSO), la función lo leerá como FALSO. Cualquier otro número que ingrese en la función lo leerá como VERDADERO.

Quizás la forma más fácil de comprobarlo sea ingresando la siguiente fórmula en una celda:

=O(0)

como verá, el resultado devuelto por la fórmula introducida es FALSO.

¿Qué provecho se puede sacar de esto?

Bueno, supongamos que usted quiere que una celda se muestre en blanco si el valor en otra es 0 y de lo contrario que muestre cualquier otro resultado. La forma 'tradicional' de hacerlo sería:

=SI(A1=0;"";"Prueba")

Lo que hará esta fórmula es mostrar "Prueba" en caso de que en la celda A1 haya un valor distinto de 0. Si el valor en A1 es 0, la fórmula mostrará como resultado "" (en blanco).

Ahora, aprovechando que Excel va a coaccionar el valor 0 como FALSO, no es necesario hacer la comparación y se podría reescribir la fórmula así:

=SI(A1;"Prueba";"")

En este caso, si el valor de A1 es 0 (FALSO), la función SI devolverá como resultado "", que es lo que queremos. En caso de que en A1 se introduzca cualquier otro valor, que será leído como VERDADERO, entonces la función arrojará como resultado "Prueba".

Importante, tenga en cuenta que Excel sólo coacciona valores numéricos a valores lógicos, no texto. Por lo que si el valor en A1 para el ejemplo anterior es algún texto, la fórmula arrojará ERROR.

Avanzando un poco más con esta noción, vemos como podríamos reemplazar también las funciones O e Y por operaciones matemáticas. Es decir, en lugar de usar algo como:

=SI(O(A1=0;A2=0);"";"Prueba")

podríamos usar esto:

=SI(A1+A2;"Prueba";"")

En el primer caso la función evaluará el valor de A1, si el valor de A1 es igual a 0 arrojará VERDADERO. Luego evaluará A2, si el valor de A2 es 0 entonces arrojará verdadero. Luego usará la función O y ya que ambos valores son verdaderos, devolverá VERDADERO. Finalmente, al evaluar la función SI devolverá "" que es lo que queremos que la función arroje en caso de que el valor en A1 o en A2 sea igual a cero.

En el segundo caso el proceso es mucho más simple e igual de efectivo. Si tanto el valor en A1 como A2 es 0, la suma de ellos dará 0, que será evaluado como FALSO y por lo tanto devolverá "", que es lo mismo que buscábamos con la función original.

Siguiendo esta misma lógica vemos cómo la función Y puede ser reemplazada por la multiplicación:

=SI(Y(A1=0;A2=0);"";"Prueba")

arrojará el miso resultado que:

=SI(A1*A2;"Prueba";"")

pues con que una de las dos celdas contenga un 0, el resultado de la multiplicación será 0 y por lo tanto será evaluado como FALSO y la función devolverá "". Será necesario que en ambas celdas sean introducidos valores distintos a 0 para que el resultado de la multiplicación no sea 0 y por lo tanto evalúe como VERDADERO.

Continué leyendo la segunda parte: Valores lógicos a valores numéricos.

Listar gráficos y la información de cada uno de ellos por medio de VBA

2010-06-07T00:29:00.000-07:00

La siguiente macro listará todos los gráficos que se encuentren en la hoja que se le indique (en este caso "Hoja1"). La macro creará una nueva hoja y en ella mostrará el nombre de cada uno de los gráficos de la hoja en cuestión, el tipo de gráfico, el nombre de cada una de las series del gráfico y la fórmula para cada serie.

La función Gráfico_Tipo que acompaña a la macro, asigna el nombre correspondiente a la constante del tipo de gráfico. El select case que he construido para asígnar el tipo de gráfico correspondiente lo he construido con base en la información que se encuentra acá.

Sub Listar_Graficos()


    Dim oGraf As Excel.ChartObject
    Dim shHoja As Excel.Worksheet
    Dim scserie As Excel.Series
    Dim fila As Long
    
    
    Set shHoja = Sheets("Hoja1")
    
    
    Application.ScreenUpdating = False
    
    
    If shHoja.ChartObjects.Count = 0 Then
    
        MsgBox "No hay graficos en las hoja."
    
    Else
        
        With Sheets.Add
            .Range("a1:d1") = VBA.Array("Nombre", "Tipo", "Serie", "Formula")
            With .Range("a2")
                For Each oGraf In shHoja.ChartObjects
                    .Offset(fila).Resize(, 2) = VBA.Array(oGraf.Name, Grafico_tipo(oGraf.Chart.ChartType))
                    For Each scserie In oGraf.Chart.SeriesCollection
                        .Offset(fila, 2).Resize(, 2) = VBA.Array(scserie.Name, "'" & scserie.Formula)
                        fila = fila + 1
                    Next scserie
                    fila = fila + 1
                Next oGraf
            End With
            .UsedRange.Columns.AutoFit
        End With
    
    End If
    
    
    Application.ScreenUpdating = True
    
    
End Sub

Private Function Grafico_tipo(ByVal Tipo As Integer) As String

    Select Case Tipo
        Case -4098: Grafico_tipo = "3D Area"
        Case 78:    Grafico_tipo = "3D Stacked Area"
        Case 79:    Grafico_tipo = "100% Stacked Area"
        Case 60:    Grafico_tipo = "3D Clustered Bar"
        Case 61:    Grafico_tipo = "3D Stacked Bar"
        Case 62:    Grafico_tipo = "3D 100% Stacked Bar"
        Case -4100: Grafico_tipo = "3D Column"
        Case 54:    Grafico_tipo = "3D Clustered Column"
        Case 55:    Grafico_tipo = "3D Stacked Column"
        Case 56:    Grafico_tipo = "3D 100% Stacked Column"
        Case -4101: Grafico_tipo = "3D Line"
        Case -4102: Grafico_tipo = "3D Pie"
        Case 70:    Grafico_tipo = "Exploded 3D Pie"
        Case 1:     Grafico_tipo = "Area"
        Case 76:    Grafico_tipo = "Stacked Area"
        Case 77:    Grafico_tipo = "100% Stacked Area"
        Case 57:    Grafico_tipo = "Clustered Bar"
        Case 71:    Grafico_tipo = "Bar of Pie"
        Case 58:    Grafico_tipo = "Stacked Bar"
        Case 59:    Grafico_tipo = "100% Stacked Bar"
        Case 15:    Grafico_tipo = "Bubble"
        Case 87:    Grafico_tipo = "Bubble with 3D effects"
        Case 51:    Grafico_tipo = "Clustered Column"
        Case 52:    Grafico_tipo = "Stacked Column"
        Case 53:    Grafico_tipo = "100% Stacked Column"
        Case 102:   Grafico_tipo = "Clustered Cone Bar"
        Case 103:   Grafico_tipo = "Stacked Cone Bar"
        Case 104:   Grafico_tipo = "100% Stacked Cone Bar"
        Case 105:   Grafico_tipo = "3D Cone Column"
        Case 99:    Grafico_tipo = "Clustered Cone Column"
        Case 100:   Grafico_tipo = "Stacked Cone Column"
        Case 101:   Grafico_tipo = "100% Stacked Cone Column"
        Case 95:    Grafico_tipo = "Clustered Cylinder Bar"
        Case 96:    Grafico_tipo = "Stacked Cylinder Bar"
        Case 97:    Grafico_tipo = "100% Stacked Cylinder Bar"
        Case 98:    Grafico_tipo = "3D Cylinder Column"
        Case 92:    Grafico_tipo = "Clustered Cone Column"
        Case 93:    Grafico_tipo = "Stacked Cone Column"
        Case 94:    Grafico_tipo = "100% Stacked Cylinder Column"
        Case -4120: Grafico_tipo = "Doughnut"
        Case 80:    Grafico_tipo = "Exploded Doughnut"
        Case 4:     Grafico_tipo = "Line"
        Case 65:    Grafico_tipo = "Line with Markers"
        Case 66:    Grafico_tipo = "Stacked Line with Markers"
        Case 67:    Grafico_tipo = "100% Stacked Line with Markers"
        Case 63:    Grafico_tipo = "Stacked Line"
        Case 64:    Grafico_tipo = "100% Stacked Line"
        Case 5:     Grafico_tipo = "Pie"
        Case 69:    Grafico_tipo = "Exploded Pie"
        Case 68:    Grafico_tipo = "Pie of Pie"
        Case 109:   Grafico_tipo = "Clustered Pyramid Bar"
        Case 110:   Grafico_tipo = "Stacked Pyramid Bar"
        Case 111:   Grafico_tipo = "100% Stacked Pyramid Bar"
        Case 112:   Grafico_tipo = "3D Pyramid Column"
        Case 106:   Grafico_tipo = "Clustered Pyramid Column"
        Case 107:   Grafico_tipo = "Stacked Pyramid Column"
        Case 108:   Grafico_tipo = "100% Stacked Pyramid Column"
        Case -4151: Grafico_tipo = "Radar"
        Case 82:    Grafico_tipo = "Filled Radar"
        Case 81:    Grafico_tipo = "Radar with Data Markers"
        Case 88:    Grafico_tipo = "High-Low-Close"
        Case 89:    Grafico_tipo = "Open-High-Low-Close"
        Case 90:    Grafico_tipo = "Volume-High-Low-Close"
        Case 91:    Grafico_tipo = "Volume-Open-High-Low-Close"
        Case 83:    Grafico_tipo = "3D Surface"
        Case 85:    Grafico_tipo = "Surface (Top View)"
        Case 86:    Grafico_tipo = "Surface (Top View wireframe)"
        Case 84:    Grafico_tipo = "3D Surface (wireframe)"
        Case -4169: Grafico_tipo = "Scatter"
        Case 74:    Grafico_tipo = "Scatter with Lines"
        Case 75:    Grafico_tipo = "Scatter with Lines and No Data Markers"
        Case 72:    Grafico_tipo = "Scatter with Smoothed Lines"
        Case 73:    Grafico_tipo = "Scatter with Smoothed Lines and No Data Markers"
    End Select

End Function

Notación abreviada para referirse a un rango versus Range

2010-06-04T11:14:00.000-07:00

La llamada notación abreviada es una forma de referirse a un rango (o a algún otro objecto en Excel, como una hoja) haciendo uso del método Evaluate. El método Evaluate es quizás uno de los más poderosas en VBA y tiene múltiples usos. Sin embargo, en este caso hablaremos exclusivamente de su uso para referirse a un rango.

Leyendo la ayuda sobre Evaluate en el editor de VB encontramos esto:

Convierte un nombre de Microsoft Excel en un objeto o un valor.

Esto quiere decir que si tenemos un nombre de un objeto de Excel (por ejemplo, "A1" que es el nombre de la celda A1, podemos convertir ese nombre en el objecto al que hace referencia por medio de Evaluate: Evaluate("A1"). Si tenemos una hoja llamada "Hoja1", podemos convertir ese nombre en un objeto pasándoselo al método Evaluate: Evaluate("Hoja1"), etc.

Ciertamente, aún no hemos hecho uso de la notación abreviada. La notación abreviada es una forma 'abreviada' de utilizar el método Evaluate y quizás usted ya la haya visto en alguna ocasión: [A1].

En este caso [A1] equivale a Evaluate("A1"), que será convertido por el método Evaluate a Range("A1").

Así, resulta muy conveniente usar la notación abreviada: [A1].select, [A1] = "Prueba", etc.

Lo que se debe tener en cuenta es que [A1] no equivale a Range("A1"), equivale a Evaluate("A1") y lo que hará Evaluate("A1") será convertir el texto entre paréntesis en el objecto correspondiente: Range("A1").

Esto quiere decir que el uso de [A1] necesariamente implica un paso de más a usar directamente Range("A1"), pues antes se deberá convertir "A1" al objeto Range correspondiente por medio Evaluate.

Por supuesto, esto implicará un pequeña desventaja en cuanto a rendimiento al usar [A1] versus Range("A1"). Se pueden hacer algunas pruebas para comparar los desempeños de Evaluate versus Range. A continuación copio dos funciones que he escrito con este fin y que devuelven el tiempo que tomó en ejecutarse cada una:

Haciendo uso de la notación abreviada para referirse a A1

Private Function Tiempo_Evaluate(ByVal iteraciones As Long) As Single

    Dim inicio As Single
    Dim x As Long
    Dim y As Long
    
    inicio = Timer
    
    For x = 1 To iteraciones
    
        [a1].Select
        [a1].value = iteraciones
        y = [a1].value
        
    Next x
    
    Tiempo_Evaluate = Timer - inicio
    
End Function

Haciendo uso de Range para referirse a A1

Private Function Tiempo_Range(ByVal iteraciones As Long) As Single
    
    Dim inicio As Single
    Dim x As Long
    Dim y As Long
    
    inicio = Timer
    
    For x = 1 To iteraciones
    
        Range("a1").Select
        Range("a1").value = iteraciones
        y = Range("a1").value
        
    Next x
    
    Tiempo_Range = Timer - inicio
    
End Function

Como se ve, cada función se refiere tres veces al rango "A1": Una para seleccionarlo, otra para escribir en él un valor y otra para leer de él un valor. La única diferencia es que en la función Tiempo_Evaluate se usa la notación abreviada de Evaluate para referirse al rango "A1", mientras que en la función Tiempo_Range se usa Range("A1") para referirse al mismo rango.

Ahora podemos llamar a las dos funciones y comparar sus tiempos de ejecución, indicando cuatas veces queresmo repetir el bucle en las funciones:

Public Sub Comparar()

    Dim prueba As Byte

    Const iteraciones As Long = 1000
    
    For prueba = 1 To 3
    
        Debug.Print "Evaluate:", Tiempo_Evaluate(iteraciones); "segundos"
        Debug.Print "Range:", Tiempo_Range(iteraciones); "segundos"
        Debug.Print VBA.String$(32, "=")
        
    Next prueba
        
    
End Sub

He llevado a cabo tres pruebas con esta macro (y las dos funciones correspondientes): Una con 1.000 iteraciones, otra con 10.000 y otra con 50.000 (Const iteraciones as long). En todos los casos la macro repite tres veces la llamada a las funciones, obteniendo tres resultados para cada número de iteraciones especificado. En los tres casos: 1.000, 10.000 y 50.000 (de tres ensayos cada uno) fue más rápido el uso de Range y como se ve (de acuerdo con los resultados obtenidos en mi equipo), la diferencia puede llegar a ser importante:

Const iteraciones As Long = 1000

Evaluate:      1,632813 segundos
Range:         1,277344 segundos
================================
Evaluate:      1,457031 segundos
Range:         1,121094 segundos
================================
Evaluate:      1,5625 segundos
Range:         1,042969 segundos
================================

Const iteraciones As Long = 10000

Evaluate:      18,17578 segundos
Range:         14,00391 segundos
================================
Evaluate:      18,90625 segundos
Range:         13,73438 segundos
================================
Evaluate:      18,87109 segundos
Range:         13,55469 segundos
================================

Const iteraciones As Long = 50000

Evaluate:      70,47266 segundos
Range:         50,14063 segundos
================================
Evaluate:      71,40625 segundos
Range:         51,66406 segundos
================================
Evaluate:      73,28516 segundos
Range:         52,70313 segundos
================================

Tenga en cuenta que acá se está discutiendo el uso de la notación abreviada de Evaluate para referirse a un objeto tipo Range. El uso de Evaluate va mucho más allá de esto y puede ser realmente poderoso cuando se usa para evaluar una fórmula, permitiendo en muchos casos evitar bucles y ahorrando ahí sí, mucho tiempo en la ejecución de una macro.

Sin embargo, en el caso específico que nos ocupa, esto es, el uso de la notación abreviada de Evaluate para referirse a un rango, pues vemos que aunque nos puede ahorrar algunas teclas al momento de escribir el código, al momento de ejecutarlo pude enlentecer la macro en la que se use... claro, la diferencia no va a ser significativa si se usa una vez, pero en definitiva, si se quisiera ganar hasta la última mílesima de segundo en rendimiento, quizás convenga evitar siempre la notación abreviada para referirse a un rango.

Sería interesante que usted mismo hiciera unas pruebas y ver si sus resultados respaldan lo expuesto... así que lo animo a que haga las pruebas correspondientes y comparta sus resultados.

Orden de las operaciones y uso del paréntesis en Excel

2010-06-01T18:27:00.000-07:00

Para muchas personas puede resultar confuso el uso de los paréntesis y la prioridad de cierta operación matemática en una fórmula ingresada en Excel. En realidad, el orden de las operaciones que lleva a cabo Excel sigue unas reglas establecidas que se aplican desde las matemáticas.

Para recordar estas reglas fácilmente, se suelen llamar PEMDAS, estos es:

P : Paréntesis
E : Exponentes y raíces
M : Multiplicación
D : División
A : Adición
S : Substracción

Sin embargo, este mnemotécnico (PEMDAS) puede generar confusión, pues no es del todo exacto. En realidad, la multiplicación y la división tienen el mismo orden, y la suma y la resta también. Por lo que quizás sea mejor usar algo como:

P : Paréntesis
E : Exponentes y raíces
M : Multiplicación y división
A : Adición y substracción

En Excel se puede comprobar fácilmente que la adicción y la substracción tienen el mismo orden de precedencia en una operación, ingresando:

=1+2-3

=3-1+2

En el primer caso el resultado es 0, pues se llevan a cabo las operaciones de izquierda a derecha:

1+2 = 3 ; 3–3 = 0

En el segundo caso el resultado es 4, pues de la misma forma se llevan a cabo las operaciones de izquierda a derecha sin que haya precedencia de la suma sobre la resta:

3–1 = 2 ; 2+2 = 4

Para forzar la precedencia de la suma sobre la resta, habría que encerrarla entre paréntesis:

=3–(1+2)

Que se resolvería:

(1+2) = 3 ; 3–3 = 0

Formula	Resultado
=1+2-3	0
=3-1+2	4
=3-(1+2)	0

Por esto mismo, se podría prescindir de los paréntesis en una fórmula como esta:

=(A1/A$1)*100

pues de cualquier forma se va a llevar a cabo primero la división (ya que no hay precedencia de la multiplicación sobre la división, simplemente se resolverá la fórmula de izquierda a derecha). Si se quisiera forzar la multiplicación en primera instancia, sí habría que encerrarla entre paréntesis, pues éstos se resolverán antes de resolver cualquier otro operador:

=A1/(A$1*100)

Formula	Resultado
=(50/2)*100	2500
=50/2*100	2500
=50/(2*100)	0.25

Falta mencionar los operadores lógicos (>, >=, <, <=, =), que son los últimos en resolverse. Por lo que:

=1=1*2

es distinto de:

=(1=1)*2

En el primer caso, ya que los operadores lógicos se resuelven en última instancia, la operación que se llevará a cabo sería:

1*2 = 2 ; 1=2 = FALSO

En el segundo caso, los paréntesis obligan a resolver primero la comparación lógica y luego multiplicar el resultado por 2:

1=1 = VERDADERO ; VERDADERO * 2 = 2

Formula	Resultado
=1=1*2	FALSO
=(1=1)*2	2

Si desea observar cómo Excel va resolviendo una fórmula introducida en una celda, puede usar el Evaluador de Fórmulas:

Para más y mejor información, consulte la ayuda de Excel bajo el tema Operadores de cálculo y prioridad.

Enviar información desde Excel a Internet por medio de VBA

2010-05-30T19:03:00.000-07:00

El siguiente código permite enviar el texto que se desea a la sección de comentarios de esta entrada. El código permite ilustrar cómo enviar información a una página Web una vez identificado el elemento de la página al cual se quiere enviar la información:

Sub Comentar(ByVal Comentario As String)

    Dim ie As Object
    
    Set ie = CreateObject("internetexplorer.application")

    With ie
        .navigate "http://www.blogger.com/comment-iframe.g?blogID=4832124315378145262&postID=2256177293721011997"
        Do While .readystate <> 4: Loop
        .document.forms(0).Item(18).Value = Comentario
        .Visible = True
    End With
    
    Set ie = Nothing
      
End Sub

Tenga en cuenta que la macro no publicará el comentario, sólo escribirá el texto que usted decida en el espacio para escribir comentarios.

En el siguiente archivo he usado un Userform para pasarle la información a la macro: Enviar información a una página Web.xls

También podría probar algo así:

Sub Prueba()
    
    Comentar Comentario:="Este es un comentario de prueba enviado desde Excel."
    
End Sub

La guerra de las hojas de cálculo

2010-05-29T23:17:00.000-07:00

Borrar gráficos en un libro de Excel por medio de VBA

2010-05-28T14:07:00.000-07:00

La siguiente macro borrará todos los gráficos del libro activo de Excel. Los gráficos en un libro pueden ser de dos tipos: Gráficos insertados en una hoja (Chartobject) o gráficos como tal, en una hoja independiente cada uno (Chart). La macro borrará ambos tipos de gráficos:

Sub Borrar_gráficos()


    Dim x As Long
    
    
    Application.DisplayAlerts = False
    
    
    For x = ActiveWorkbook.Sheets.Count To 1 Step -1

        If VBA.TypeName(Sheets(x)) = "Chart" Then
        
            Sheets(x).Delete
            
        ElseIf Sheets(x).Type = xlWorksheet Then
        
            Sheets(x).ChartObjects.Delete
            
        End If
    
    Next x
    
    
    Application.DisplayAlerts = True
    

End Sub

Si se desean borrar sólo los gráficos insertados en las hojas (ChartObjects), esto lo hará, borrando de todas las hojas del libro activo todos los gráficos insertados que encuentre:

Sub Borrar_ChartObjects_libro()


    Dim sh As Excel.Worksheet
    
    
    For Each sh In ActiveWorkbook.Worksheets
        
        sh.ChartObjects.Delete
            
    Next sh
    

End Sub

Para borrar sólo los gráficos en una hoja, bastará con quitar el bucle que recorre las hojas y especificar la hoja en la que se quiere borrar los gráficos, por ejemplo, la hoja "Hoja1":

Sub Borrar_ChartObjects_hoja()
 
    Sheets("Hoja1").ChartObjects.Delete

End Sub

Finalmente, para borrar sólo los gráficos en hojas independientes (Charts), conservando los gráficos insertados en las hojas, se podrías usar algo así:

Sub Borrar_Charts()


    Dim Ch As Excel.Chart
    
    
    Application.DisplayAlerts = False
    
    
    For Each Ch In ActiveWorkbook.Charts
        
       Ch.Delete
         
    Next Ch
    
    
    Application.DisplayAlerts = True
    
    
End Sub

Se podría escribir una función que reciba como argumentos el tipo de gráficos que se desea borrar y el ámbito (todo el libro o alguna hoja en específico) y que arroje un valor de verificación (por ejemplo, Verdadero si se han borrado con éxito o Falso si se ha presentado algún error). Si se trabaja con gráficos de manera frecuente, una función de ese tipo puede ser útil.

Sin embargo, puede resultar ilustrativo ver las diferencias entre Chart y ChartObject y distintas formas de abordar el problema. Tenga en cuenta que un ChartObject contiene un Chart: Sheets("Hoja1").ChartObjects(1).Chart se refiere al gráfico que se encuentra en el ChartObject 1 insertado en la hoja "Hoja1". Un gráfico insertado en una hoja siempre será un ChartObject que contendrá un Chart. Un gráfico en una hoja independiente será un Chart, pasando la hoja a ser una hoja tipo Chart y no una hoja WorkSheet. Puede comprobarlo haciendo uso de la función TypeName: debug.print TypeName(Sheets(1)). Si Sheets(1) es un gráfico, typename devolverá "Chart", de lo contrario devolverá "Worksheet".

Si la ha parecido interesante esta información o tiene alguna corrección o comentario u otra forma de hacerlo, no dude en escribir en la sección de comentarios.

Los orígenes de Microsoft Excel: VisiCalc

2010-05-27T10:39:00.000-07:00

Investigando un poco sobre los orígenes de Excel me he encontrado con lo que me ha parecido una verdadera curiosidad: el programa original de VisiCalc en su totalidad, para descargar y usar gratuitamente.

Claro, es un objeto de anticuario. No creo que nadie vaya a cambiar su versión de Microsoft Excel, por antigua que sea, por el viejo VisiCalc. Pero si se quiere tener un ‘objeto de colección’ (si es que existe algo así en el mundo de las hojas de Cálculo) y uno es aficionado a Excel, se sentirá como con un auto de colección en el garaje.

VisiCalc es nada más y nada menos que la primera hoja de cálculo, creada por dos estudiantes del MIT: Dan Bricklin y Bob Frankston. En Octubre de 1979 salió al mercado VISIble CALCulator para Apple IIe, con el nombre de VisiCalc.

Si quiere descargarlo, acá lo encuentra, así como toda una página museo con documentación sobre su história y su uso: VisiCalc.

Nota al pie de página: Sabia que en Excel usted puede ingresar una función precedida de "@", por ejemplo: @SUMA(A1:A10). Si no recuerdo mal, esto es para compatibilidad con Lotus y remontándonos a los orígenes... en VisiCalc las funciones se invocaban de esa forma: @SUM.

Escribir datos por medio de una conexión ADO en un libro de Excel cerrado

2010-05-25T19:40:00.000-07:00

He estado tratando de encontrar una forma sencilla para escribir datos por medio de VBA en un libro de Excel cerrado . Esto parece ser posible estableciendo una conexión ADO (ActiveX Data Objects).

Para poder trabajar con una conexión ADO, es necesario establecer una referencia a Microsft ActiveX Data Objects (elija la versión más reciente que encuentre).

Para los códigos que voy a usar, estoy suponiendo un libro llamado "Libro1.xls", que en el rango A1:F1 de la hoja "Hoja1" tiene estos encabezados, a partir de los cuales vamos a ingresar datos:

Libro1.xls - Hoja1

	A	B	C	D	E	F
1	Dato1	Dato2	Dato3	Dato4	Dato5	Dato6
2

La macro para ingresar los datos, ejecutándola desde Excel 2007, podría ser algo así:

Sub Escribir_datos()

    Dim Data As ADODB.Connection
    Dim Datos As String


    'DATOS DEL ARCHIVO EN EL QUE SE VA A ESCRIBIR
    'Si el archivo en el que va a escribir los datos es versión
    '2007, cambie "Excel 8.0" por "Excel 12.0"
    Const Archivo As String = "C:\Users\Mauricio\Desktop\Libro1.xls"
    Const Version As String = "Excel 8.0"
    Const Hoja As String = "Hoja1"
    
    
    'DATOS DE LA CONEXION
    'Corresponde a la versión de Excel desde la cual va a ejecutar la macro
    'Si ejecuta la macro desde Excel 2003 use "Microsoft.Jet.OLEDB.4.0"
    Const Proveedor As String = "Microsoft.ACE.OLEDB.12.0"
    
    
    'Los datos que se van a ingresar, separados por comas.
    Datos = "'Prueba1', 1, 'Prueba2', 0.02, 3, 4"
    
    
    Set Data = New ADODB.Connection
    
    with Data
        .Open "Provider=" & Proveedor & ";" & _
              "Data Source=" & Archivo & ";" & _
              "Extended Properties=""" & Version & ";HDR=Yes"";"
    
        .Execute "INSERT INTO [" & Hoja & "$] VALUES(" & Datos & ");", , adCmdText Or adExecuteNoRecords
    
        .Close
    End with
    
    Set Data = Nothing
    

End Sub

Para la constante Archivo, ingrese la ruta completa del archivo en el que quiere escribir los datos, en este caso: "C:\Users\Mauricio\Desktop\Libro2.xls"

Para la constante Version, ingrese "Excel 8.0" si el archivo en el que quiere escribir los datos es .xls (como en este caso) o "Excel 12.0" si el archivo en el que quiere escribir los datos es versión 2007 (.xlsx o .xlsm).

Para la constante Proveedor, ingrese "Microsoft.ACE.OLEDB.12.0" si la macro la ejecuta desde Excel 2007 o "Microsoft.Jet.OLEDB.4.0" si la ejecuta desde Excel 2003.

Imprtante, la constante Versión se refiere al libro al cual quiere escribir lo datos. La constante Proveedor corresponde a la versión de Excel desde la cual ejecute la macro.

Si decide realizar algunas pruebas, recuerde hacerlo manteniendo el archivo en el que desea escribir cerrado, pues de mantenerlo abierto mientras ejecuta la macro se puede generar una pérdida en el uso de memoria de Excel: http://support.microsoft.com/kb/319998

Resultado tras ejecutar la macro

	A	B	C	D	E	F
1	Dato1	Dato2	Dato3	Dato4	Dato5	Dato6
2	Prueba1	1	Prueba2	0,02	3	4

Note que todos los valores han sido ingresados como texto. Al ingresar datos por medio de una conexión ADO, de manera predeterminada se ingresarán los valores con el formato de la celda que encuentre arriba (aunque esto no es del todo exacto, sirve para entender qué ha pasado. Para información más detallada, revise este artículo: http://support.microsoft.com/kb/257819). Fíjese que todos los encabezados están en forma de texto. Si quisieramos especificar un tipo de dato y formato para los datos que vayamos a pasar, podríamos indicar con una fila dummy el formato que queremos para cada columna.

Vamos a cambiar los datos en la tabla de la Hoja1 y los vamos a disponer así:

Usando una segunda fila dummy para indicar el tipo de datos que queremos en cada columna

	A	B	C	D	E	F
1	Dato1	Dato2	Dato3	Dato4	Dato5	Dato6
2	Texto	1.00	Texto	1%	$ 1.00	1

La fila2, que he ingresado manualmente, sirve para indicar el tipo y el formato para los datos que se quiere en esas columnas. Para las columnas B, D, E y F he ingresado datos numéricos y le he dado un formato específico a cada uno. Para las columnas A y C estoy ingresando texto. Esta fila se puede ocultar y la macro igual ingresará correctamente los datos:

Resultado tras ejecutar la macro con fila dummy indicando el tipo de datos

	A	B	C	D	E	F
1	Dato1	Dato2	Dato3	Dato4	Dato5	Dato6
2	Texto	1.00	Texto	1%	$ 1.00	1
3	Prueba1	1.00	Prueba2	2%	$ 3.00	4

Si se quisiera hacer algo un poco más global y hasta de pronto crear una función para escribir datos en un libro sin necesidad de abrirlo, se podría pensar en algo así (la función devolverá verdadero si se han pasado los datos con éxito o Falso si se ha presentado algún error durante la transferencia):

Function Pasar_datos(ByVal Archivo As String, ByVal Hoja As String, ByRef Datos() As Variant) As Boolean
   
    Dim Registro As ADODB.Recordset
    Dim Data As ADODB.Connection
    Dim Proveedor As String
    Dim Version As String
    Dim x As Byte, y As Byte
    
    Pasar_datos = False
    
    On Error GoTo Salir
    
    'Tipo de conexión según el archivo en el que se use la función
    If VBA.Val(VBA.Mid(Application.Version, 1, VBA.InStr(1, Application.Version, ".") - 1)) >= 12 Then
        Proveedor = "Microsoft.ACE.OLEDB.12.0" 'Excel 2007
    Else
        Proveedor = "Microsoft.Jet.OLEDB.4.0" 'Excel 2003
    End If
    
    Version = VBA.Right(Archivo, VBA.Len(Archivo) - VBA.InStr(Archivo, "."))
    
    'Versión del archivo destino
    If Version Like "xls?" Then
        Version = "Excel 12.0" 'Excel 2003
    ElseIf Version Like "xls" Then 'Excel 2007
        Version = "Excel 8.0"
    Else
        'No se está trabajando con una archivo de Excel válido
        Exit Function
    End If
    
    Set Data = New ADODB.Connection
    Data.Open "Provider=" & Proveedor & ";" & _
              "Data Source=" & Archivo & ";" & _
              "Extended Properties=""" & Version & ";HDR=Yes"";"
    
    Set Registro = New ADODB.Recordset
    
    With Registro
        .CursorLocation = adUseClient
        .Open "Select * from [" & Hoja & "$]", Data, adOpenStatic, adLockOptimistic
        .AddNew
        y = 0
        For x = LBound(Datos) To UBound(Datos)
            .Fields(VBA.Val(y)).Value = Datos(x)
            y = y + 1
        Next x
        .Update
        .Close
    End With
    
Salir:

    Set Registro = Nothing
    
    Data.Close
    
    Set Data = Nothing
    
    Pasar_datos = Not VBA.CBool(Err.Number)
   
End Function

Los argumentos que deberá pasar a la función son:

Archivo as String
La ruta del archivo en el que desea escribir los datos, por ejemplo: "C:\Users\Mauricio\Desktop\Libro2.xls"

Hoja as String
El nombre de la hoja del archivo en la que desea escribir los datos, por ejemplo: "Hoja1"

Datos() as Variant
Una matriz de datos de una dimensión con el mismo número de elementos al de las columnas en las que se van a ingresar los datos

Suponiendo que vamos a ingresar datos en la "Hoja1" del libro "Libro1.xls" y que esta es la estructura de la tabla en la cual vamos a ingresar datos (observe que a la columna B, en la fila dummy que indica el tipo de datos, estoy indicando que quiero pasar allí dato de tipo Fecha, para lo cual he ingresado un fecha cualquiera y le he dato el formato de fecha que quiero):

Libro1.xls - Hoja1

	A	B	C	D	E	F
1	Dato1	Dato2	Dato3	Dato4	Dato5	Dato6
2	Texto	1/1/2001	Texto2	1%	$ 1.00	1

Podríamos usar algo así:

Sub prueba()

    Dim Datos(1 To 6) As Variant
    
    Datos(1) = "Prueba1"
    Datos(2) = VBA.DateSerial(2010, 5, 25)
    Datos(3) = "Prueba2"
    Datos(4) = 0.02
    Datos(5) = 3
    Datos(6) = 4
        
    If Pasar_datos("C:\Users\Mauricio\Desktop\Libro1.xls", "Hoja1", Datos) Then
        MsgBox "Se ha completado con éxito la transferencia de datos."
    Else
        MsgBox "Se ha presentado algún error durante la transferencia."
    End If
    
    Erase Datos
    
End Sub

Resultado tras usar la función Pasar_datos(Archivo, Hoja, Datos())

	A	B	C	D	E	F
1	Dato1	Dato2	Dato3	Dato4	Dato5	Dato6
2	Texto	1/1/2001	Texto	1%	$ 1.00	1
3	Prueba1	25/5/2010	Prueba2	2%	$ 3.00	4

¡Importante! Ya sea que use la subrutina o la función,

la cantidad de datos que ingrese debe coincidir con el número de columnas que tenga la tabla en la hoja de destino;
Cuando pase los datos, debe 'respetar' el tipo de datos que esté indicando en la fila dummy. Es decir, si en la fila dummy está indicando que el tipo de datos para la columna 2 es Fecha (como en el último ejemplo), el dato que pase para dicha columna debe ser una Fecha.

Para más información sobre ADO, en la página de Microsoft encontrará más que suficiente documentación y ejemplos: Microsoft ActiveX Data Objects.

Si esta información le ha parecido útil o interesante, déjelo saber en los comentarios. También advierto que no soy un experto en conexiones de datos, así que si usted conoce una mejor forma de hacerlo o encuentra algún error, le agradeceré que lo comente. En todo caso, lo mostrado acá tiene sus ventajas y desventajas, y en muchos casos puede ser mucho más sencillo simplemente abrir el libro, pasar los datos y cerrarlo nuevament :D.

Importar datos en tiempo real desde un página Web a Excel

2010-05-24T20:20:00.000-07:00

El siguiente vídeo muestra cómo importar datos desde una tabla en una página Web a Excel haciendo uso de una Conexión a Datos. El procedimiento está explicado para Excel 2007 pero igual aplica para otras versiones.

Si quiere más información, consulte la página de Microsoft Excel:

Demostración experimental del Teorema del Límite Central

2010-05-22T21:59:00.000-07:00

El Teorema del Límite Central es quizás la principal razón por la cual la distribución normal es tan importante. En pocas palabras, el teorema postula que sin importar cuál sea la distribución de una población, si se obtiene un número grande de muestras aleatorias, los promedios o las sumas de esas muestras se aproximarán a una distribución normal.
La plantilla que acompaña a esta entrada presenta una demostración experimental del teorema. En el archivo se deben especificar el número de muestras que se desean obtener y su tamaño. A continución, por medio de una macro, se crearán las muestras indicadas del tamaño indicado usando la función ALEATORIO(). La función aleatorio devuelve valores entre 0 y 1, con una distribución uniforme, esto es, cada valor en ese rango tiene la misma probabilidad de salir.
Posteriormente, la macro calculará los promedios de todas las muestras obtenidas y por medio de fórmulas y nombres definidos se calculá una tabla de frecuencias que alimenta el histograma, en el que se puede ver la distribución final. Pruebe ingresando en la plantilla distintos tamaños y cantidades de muestras para comprobar por usted mismo el teorema.
El siguiente gráfico corresponde a 10 muestras de tamaño 10 cada una (es decir, la macro calcula 10 filas, cada una siendo una muestra, por diez columnas, cada una siendo una dato de la muestra correspondiente):

Como se ve, el resultado está lejos de una distribución normal. Pero si aumentamos el número de muestras incluidas empezamos a ver el poder del teorema. El siguiente gráfico fue calculado con 1000 muestras de tamaño 10 cada una (calculadas en 1000 filas x 10 columnas con la función aleatorio):

Como se ve (y no sé si sea yo el único que se emocione), el gráfico empieza a acercarse a una distribución normal, a pesar de que la distribución de los datos originales sea una distribución uniforme 0-1.Finalmente, este último gráfico corresponde a un millón de muestras. Si si, eso dije, un millón de muestras calculadas en Excel 2007, de 10 elementos cada una (esto es un millón de filas x 10 columnas con la función aleatorio). Como se ve, y esto es absolutamente impresionante, el resultado está bastante cerca de una distribución normal, aunque la distribución de los datos originales sea uniforme:

Si este tema le resulta interesante y quiere explorar un poco más, quizás esta otra demostración le interese: onlinestatbook.
Adjunto una nueva versión del archivo ya que he tenido problemas con el archivo anterior (el que se muestra en las gráficas): Teorema del Límite Central.xls

Encontrar el último valor en un conjunto de datos: búsqueda binaria

2010-05-20T20:20:00.000-07:00

El archivo que se encuentra al final de esta entrada presenta una animación por medio de VBA para ilustrar el algoritmo de búsqueda binaria y sirve para entender por qué para encontrar el último valor en un conjunto de datos podemos usar una fórmula como esta:

=BUSCAR(9E+307;A:A)

El valor 9e+307 es notación científica y equivale a 9 x 10 ^ 307, que con seguridad será un número mayor a cualquier otro que se encuentre en el rango de búsqueda. Al buscar un número mayor a cualquier otro dentro del rango de búsqueda, la fórmula traerá el último valor que encuentre.

Suponiendo que el conjunto de datos en el que queremos realizar la busqueda es este:

	A
2	42
3	10
4	33
5	31
6	14
7	15
8	16
9	17
10	23
11	9
12	36
13	33
14	47
15	21
16	17
17	26
18	48
19	22
20	12

Entonces usando la fórmula propuesta tendremos este resultado:

Búsqueda binaria

Fórmula	Resultado
=BUSCAR(9E+307;A:A)	12

Pero... ¿por qué arroja ese resultado la fórmula? Es más, si cambiamos el 9e+307 por algún otro valor, empezamos a tener resultados extraños:

Búsqueda binaria

Valor buscado	Fórmula	Resultado
9	=BUSCAR(9;A:A)	#N/A
42	=BUSCAR(42;A:A)	12
16	=BUSCAR(16;A:A)	16

Estos resultados son sumamente extraños:

En el caso de 9, vemos que se encuentra en la fila 11 de nuestra tabla y, sin embargo, la fórmula nos devuelve #N/A.

En el caso del 42, vemos que es el primer número de la tabla y, sin embargo, nos devuelve 12.

En el caso del 16, que se encuentra en la fila 8 del rango de búsqueda, sí nos devuelve el valor correcto.

¿Qué está pasando? La respuesta tiene que ver con el algoritmo usado por la fórmula, llamado búsqueda binaria y que resulta muy rápido en comparación con una búsqueda lineal (dato por dato). El problema es que la búsqueda binaria funciona en datos ordenados. Esto lo podemos leer en la misma ayuda de la función (http://support.microsoft.com/kb/324986/es):

Importante Los valores del vector_de_comparación se deben colocar en orden ascendente: ...,-2, -1, 0, 1, 2, ..., A-Z, FALSO, VERDADERO; de lo contrario, BUSCAR puede devolver un valor incorrecto.

Es necesario que los datos estén ordenados de manera ascendente porque el algoritmo de búsqueda binaria irá partiendo el rango de búsqueda por mitades (de ahí su nombre) y comparará el valor buscado con el valor de la mitad, para así ir descartando datos hasta llegar a una respuesta.

Si buscamos 9e+307, primero encontramos el valor de la mitad y como el valor de la mitad es menor que el valor buscado, necesariamente el valor buscado estará en la mitad superior (recuerde que la función BUSCAR está asumiendo que los datos están ordenados de manera ascendente) y por lo tanto se puede descartar el 50% de los datos inferiores, pasando a buscar en el rango de datos superiores:

	A
2	42
3	10
4	33
5	31
6	14
7	15
8	16
9	17
10	23
11	9
12	36
13	33
14	47
15	21
16	17
17	26
18	48
19	22
20	12

Ahora partimos el rango de datos superiores por la mitad y encontramos que nuevamente el valor de la mitad es inferior al valor buscado, así que podemos descartar nuevamente la mitad inferior del rango:

	A
11	9
12	36
13	33
14	47
15	21
16	17
17	26
18	48
19	22
20	12

Una vez más partimos el rango superior (recuerde que lo estoy llamando 'superior' porque la función BUSCAR está asumiendo que los datos están ordenados de manera ascendente, así que en esa mitad se deberían encontrar valores superiores a los de la otra mitad):

	A
16	17
17	26
18	48
19	22
20	12

De nuevo descartamos la mitad inferior, pues el valor buscado es mayor al valor de la mitad:

	A
19	22
20	12

Y como se ve, el único resultado posible es el último valor, no importa cuáles sean los datos del rango en el que se busca, si el valor buscado es mayor a cualquier otro dato al interior de la tabla, siempre pasará lo mismo y arrojará como resultado el último valor.

Intente usted seguir la secuencia para llegar a los resultados obtenidos cuando se busca 9, 42 y 6.

Si quiere seguir una animación y observar los resultados devueltos en distintas condiciones descarque el archivo: Búsqueda binaria.xls

En el archivo se presenta una animación que ilustra paso a paso lo que está haciendo la fórmula y cómo llega al resultado.

Tenga en cuenta que el código que usado en el arhivo para ejemplificar la búsqueda NO equivale en lo absoluto al algoritmo que se encuentra detrás de la fórmula. El código simplemente sirve para ilustrar paso a paso el proceso de búsqueda binaria pero no representa como tal el algoritmo.

Desplazarse por una hoja de Excel usando el cuadro de nombres

2010-05-20T12:57:00.000-07:00

El cuadro de nombres, que se encuentra a la izquierda de la barra de fórmulas, es una herramienta muy útil para asignar rápidamente nombres a celdas y desplazarse a lo largo de la hoja. El siguiente vídeo explica rápidamente cómo usarla:

Si usted conoce algún otro truco para desplazarse rápidamente a través de la hoja o trabajar con nombres definidos, compártalo en la sección de comentarios… únase a la lucha para reducir el analfabetismo tecnológico en Excel :D.

Borrar todas las imágenes insertadas en una hoja de Excel

2010-05-19T15:50:00.000-07:00

El siguiente vídeo explica cómo borrar rápidamente todas las imágenes insertadas en una hoja de Excel, haciendo uso de "Ir a".

Para ello, en la hoja en la que tiene las imágenes, presione F5, seleccione "Especial" (puede presionar Alt+e) y ahora seleccione objetos (o presione "j"). Si todo ha salido bien, habrá seleccionado todas los objetos en la hoja. Ahora puede presionar Suprimir o Borrar.

El código equivalente para llevar a cabo esta acción lo puede obtener fácilmente con la grabadora de macros y se puede resumir en una línea:

Sheets("Hoja1").DrawingObjects.Delete

Mostrar fórmula en una celda

2010-05-19T12:41:00.001-07:00

La siguiente función definida por el usuario permitirá mostrar la fórmula de la celda que se le indique en diferentes formatos. A continuación, una pequeña descripción de su uso:

MostrarFormula(Formula,Tipo[Argumento opcional],Celda[Argumento opcional])

Formula es una referencia a la celda que contiene la fórmula que se desea mostrar.

Tipo[Argumento opcional]. Es el tipo de fórmula que se desea mostrar:

0 para mostrar la fórmula tal cual fue ingresada en la celda (es el valor por defecto).
1 para mostrar la fórmula en inglés.
2 para mostrarla en referencia tipo R1C1.

Celda[Argumento opcional], indica si se mostrará la dirección de la celda en la que se encuentra la fórmula que se desea mostrar. Falso (0) es el valor predeterminado, así que si se omite no mostrará la dirección de la celda. Verdadero (1) mostrará la dirección de la celda antecediendo a la fórmula.

Así, si en A11 se tiene la fórmula =SUMA(A1:A10), MostrarFormula dará los siguientes resultados:

MostrarFormula(Formula,[Tipo],[Celda])

Formula	Resultado
=MostrarFormula(A11)	=SUMA(A1:A10)
=MostrarFormula(A11,,1)	A11: =SUMA(A1:A10)
=MostrarFormula(A11,2)	=SUM(R[-10]C:R[-1]C)
=MostrarFormula(A11,1,VERDADERO)	A11: =SUM(A1:A10)

Si la celda ingresada en MostrarFormula contiene un fórmula matricial, el resultado arrojado se mostrará entre { } indicando que es una fórmula matricial.

Si la celda ingresada en MostrarFormula no contiene una fórmula, la función arrojará error de #N/A.

Function MostrarFormula(ByVal Formula As Excel.Range, _
                        Optional ByVal Tipo As Byte = 0, _
                        Optional ByVal Celda As Boolean = False) As Variant
    
    Dim Ref As String
    
    If Formula.HasFormula Then
        
        If Celda = True Then Ref = Formula.Address(0, 0) & ": "
        
        Select Case Tipo
            Case 0
                If Formula.HasArray Then
                    MostrarFormula = Ref & "{" & Formula.FormulaLocal & "}"
                Else
                    MostrarFormula = Ref & Formula.FormulaLocal
                End If
            Case 1
                If Formula.HasArray Then
                    MostrarFormula = Ref & "{" & Formula.Formula & "}"
                Else
                    MostrarFormula = Ref & Formula.Formula
                End If
            Case 2
                If Formula.HasArray Then
                    MostrarFormula = Ref & "{" & Formula.FormulaR1C1 & "}"
                Else
                    MostrarFormula = Ref & Formula.FormulaR1C1
                End If
        End Select
    
    Else
        
        MostrarFormula = VBA.CVErr(xlErrNA)
    
    End If
    
End Function

En este otro tema encontrará una macro que permite crear una matriz con la dirección, el valor y la fórmula de uno o varios rangos seleccionados: Mostrar todas las fórmulas de uno o varios rangos.

Filtrar por rango de fechas en una tabla dinámica

2010-05-19T11:19:00.001-07:00

La siguiente macro de evento permitirá filtrar entre un rango de fechas en el filtro de informe de una tabla dinámica, lo que evitará tener que seleccionar de manera manual las fechas correspondientes al rango que se desea filtrar.

Para ello, haremos uso de dos celdas complementarias en las cuales indicaremos la fecha inicial y la fecha final del rango entre el cual queremos filtrar.

En el archivo de ejemplo he usado la celda B2 para ingresar la celda inicial y la celda B3 para ingresar la fecha final que indicarán las fechas a filtrar en el filtro de informe llamado "Fecha": Filtrar entre fechas.xls

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
        
    Dim Fecha_i As Date
    Dim Fecha_f As Date
    Dim Fecha As Date
    Dim pi As PivotItem
    
    If Not Application.Intersect(Target, Me.Range("b2:b3")) Is Nothing Then
    
        If Me.Range("b3") <= Me.Range("b2") Then
            
            With Application
                .EnableEvents = False
                .Undo
                .EnableEvents = True
            End With
            
            MsgBox prompt:="La fecha de inicio debe ser menor a la fecha final.", title:="Filtro fechas"
                   
        Else
            
            On Error Resume Next
            
            Fecha_i = Me.Range("b2")
            Fecha_f = Me.Range("b3")
            
            Application.ScreenUpdating = False
            
            With ActiveSheet.PivotTables(1).PivotFields("Fecha")
                .EnableMultiplePageItems = True
                Application.EnableEvents = False
                For Each pi In .PivotItems
                    pi.Visible = True
                    Fecha = VBA.Format(pi.Value, "mm-dd-yy")
                    If Fecha < Fecha_i Or Fecha > Fecha_f Then
                          pi.Visible = False
                    End If
                Next pi
                Application.EnableEvents = True
            End With
            
            Application.ScreenUpdating = True

        End If
        
    End If
    
End Sub

Rellenar el espacio restante de una celda con un carácter en específico

2010-05-19T11:18:00.000-07:00

Por medio del formato personalizado se pueden lograr algunos efectos interesantes para mostrar en una celda. El siguiente vídeo muestra cómo repetir un carácter en específo en el espacio restante de una celda, sin importar cuál sea el ancho de la columna y sin afectar el valor en la celda.

Para más y mejor información, consulte la ayuda de Microsoft Excel: Crear o eliminar un formato de número personalizado

Si conoce algún truco interesante para el formato personalizado, ¡no dude en compartirlo en la sección de comentarios!

Borrar todos los comentarios de un libro

2010-05-18T07:28:00.000-07:00

La siguiente función permite borrar todos los comentarios de un libro de Excel. La función devolverá Verdadero en caso de que se hayan borrado exitosamente todos los comentarios y Falso en caso de que no se haya presentado algún error:

Function borrar_comentarios(ByVal wbLibro As Excel.Workbook) As Boolean

    On Error Resume Next
        wbLibro.RemoveDocumentInformation xlRDIComments
        borrar_comentarios = Not VBA.CBool(Err.Number)
    On Error GoTo 0
    
End Function

Para usarla, simplemente invóquela pasando como argumento el libro cuyos comentarios quiere borrar:

Sub prueba()
 
    If borrar_comentarios(ActiveWorkbook) = True Then
        MsgBox "Se han borrado exitosamente todos los comentarios."      
    Else   
        MsgBox "No ha sido posible borrar los comentarios."    
    End If
        
End Sub

Tenga en cuenta que el método RemoveDocumentInformation usado en la función sólo está disponible en Excel 2007, gracias al Inspector de Documentos. En versiones anteriores habría que recorrer cada hoja y luego cada comentario en la hoja y eliminarlo uno a uno, algo así:

Sub borrar_comentarios()

    Dim hj As Excel.Worksheet
    Dim cmt As Excel.Comment
    
    For Each hj In ActiveWorkbook.Worksheets
        For Each cmt In hj.Comments
            cmt.Delete
        Next cmt
    Next hj
    
End Sub

De manera curiosa, la macro borrará los comentarios sin importar que la hoja esté protegida.

Listas dependientes sin Desref o Indirecto

2010-05-14T23:20:00.000-07:00

Las formas conocidas y frecuentes de hacer listas dependientes involucran a las funciones DESREF o INDIRECTO, ya sea como parte de un nombre definido o como parte de una fórmula en la hoja de cálculo.

Las siguientes fórmulas son una alternativa sin usar estas funciones, buscando disminuir el tiempo de recálculo del archivo que se puede ver fuertemente afectado por el uso de funciones volátiles. Tampoco se hace uso de nombres definidos.

He partido del archivo de ejemplo que ha subido uno de los más grande difusores de Excel en Español: Jorge L. Dunkelman. Esta entrada es una respuesta a su tema: Rangos dinámicos y funciones volátiles.

Estructura de los datos

	B	C	D	E	F	G
2	Zona	Agentes
3	Norte	Juan	Roberto
4	Sur	Mario	Alberto	Marcelo	Rubén
5	Este	Daniel	Ricardo	Ernesto
6	Oeste	Germán	Antonio	Manuel	Alejando	Esteban

Las siguientes tres fórmulas se pueden introducir en una Lista de Validación de datos, que dependerá de la zona que se ingrese en la celda B9:

Fórmulas en Lista de Validación de datos

	Validación de datos
Op1	=INDICE(C3:G6;COINCIDIR(B9;B3:B6;0);0)
Op2	=ELEGIR(COINCIDIR(B9;B3:B6;0);C3:D3;C4:F4;C5:E5;C6:G6)
Op3	=INDICE(C3:C6;COINCIDIR(B9;B3:B6;0)):INDICE(C3:G6;COINCIDIR(B9;B3:B6;0);CONTARA(INDICE(C3:G6;COINCIDIR(B9;B3:B6;0);0)))

Tenga en cuenta el separador de argumentos de acuerdo con la configuración regional de su equipo.

La primera opción (Op1) es ideal si todas las listas dependientes tienen la misma cantidad de datos y éstos van a permanecer constantes. Es decir, en todas las Zonas habrán siempre la misma cantidad de Agentes.

La segunda opción (Op2) es ideal si las listas dependientes tienen distinta cantidad de datos y éstos van a permanecer constantes. Es decir, suponiendo que la Zona Norte siempre va a tener 2 Agentes, la zona Sur siempre va a tener 4 Agentes, etc.

La tercera opción (Op3) es ideal si las listas dependientes tiene distinta cantidad de datos y éstos pueden variar con frecuencia.

Bueno, son sólo algunas ideas pensando en evitar el uso de DESREF e INDIRECTO para la creación de listas dependientes... si tiene alguna otra idea o una alternativa a lo propuesto ¡por favor coméntela!

Listas dependientes no volátiles.xls

Borrar los datos al interior de una o más tablas

2010-05-14T22:56:00.000-07:00

La siguiente macro permite borrar el contenido de las tablas que se seleccionen en el InputBox. La macro borrará todos los datos en la selección que no sean fórmulas y no estén en negrita.

Esto, porque se asume que los encabezados de la tabla se han resaltado con negrita y que al borrar los datos de la tabla se quieren conservar las fórmulas para reutilizarlas con nuevos ingresos.

La macro también verificará si la hoja está protegida y de estarlo, se asume que las celdas que se quieren borrar son aquellas desbloqueadas, por lo que se borrará el contenido de toda celda desbloqueada de la selección, incluidas en este caso las que contengan fórmulas y exceptuando sólo las que se encuentren en negrita.

Sub Limpiar_tablas()


    Dim dato As Excel.Range
    Dim tablas As Excel.Range
    Dim Calculo As Integer
    
    
    On Error GoTo Salir
        Set tablas = Application.InputBox(prompt:="Seleccione el rango con las tablas a limpiar.", _
                                          Title:="Limpiar tablas", _
                                          Type:=8)
    On Error GoTo 0
    
    
    With Application
        Calculo = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With
    
    
    If MsgBox(prompt:="Se van a borrar datos en el rango " & _
                       tablas.Address(0, 0) & vbLf & vbLf & _
                       "¿Desea continuar?", _
              Buttons:=vbYesNo + vbQuestion, _
              Title:="Limpiar tablas") = vbYes Then
    
        If tablas.Cells.Count > 1 Then
        
            If tablas.Parent.ProtectContents Then
            
                For Each dato In tablas
                    If Not dato.Locked And Not dato.Font.Bold Then
                        dato.MergeArea.ClearContents
                    End If
                Next dato
                
            Else
            
                On Error GoTo Salir
                    Set tablas = tablas.SpecialCells(xlCellTypeConstants)
                On Error GoTo 0
                 
                For Each dato In tablas
                    If Not dato.Font.Bold Then
                        dato.MergeArea.ClearContents
                    End If
                Next dato
                
            End If
             
        End If
    
    End If
    
    
Salir:


    Set tablas = Nothing

    With Application
        .ScreenUpdating = True
        .Calculation = Calculo
    End With
    

End Sub

Búsqueda en una tabla de doble entrada

2010-05-14T09:39:00.003-07:00

Un problema muy frecuente es el de realizar una búsqueda con dos criterios en una tabla de doble entrada. Por suerte, Excel ofrece muchas alternativas para llevar esto a cabo.

En el archivo van algunas ideas para realizar dichas búsquedas con fórmulas, algunas funcionan muy bien para la gran mayoría de los casos, otras sólo en caso de que los datos al interior de la tabla sean numéricos, otras requieren de nombres definidos, etc.

Buscar con dos parámetros.xls

Estructura de los datos

	B	C	D	E	F	G	H	I	J	K	L
4		Columna1	Columna2	Columna3	Columna4	Columna5	Columna6	Columna7	Columna8	Columna9	Columna10
5	Fila1	0,58195647	0,02308622	0,96915549	0,57549749	0,07282197	0,16483116	0,300760201	0,87158941	0,17995409	0,90422252
6	Fila2	0,80713529	0,61240727	0,42076457	0,10258494	0,14065068	0,65299679	0,436666154	0,27669217	0,74877161	0,2645273
7	Fila3	0,07881568	0,33447968	0,11295261	0,42036129	0,3457091	0,04878022	0,686620649	0,28437788	0,95929722	0,02896422
8	Fila4	0,95476975	0,78349243	0,11798208	0,25431993	0,92440227	0,17821755	0,181947608	0,46936239	0,98096472	0,08172721
9	Fila5	0,33900395	0,27142453	0,23793217	0,02386209	0,3553072	0,87219599	0,883272854	0,0462209	0,55085354	0,92367039
10	Fila6	0,21281309	0,78983852	0,73169533	0,1722176	0,41975709	0,13649921	0,285230511	0,81417633	0,69248451	0,61449292
11	Fila7	0,30705161	0,33464043	0,922971	0,0417685	0,7144045	0,32095338	0,269071289	0,57578753	0,13861776	0,61712884
12	Fila8	0,31766016	0,23185527	0,96287856	0,9179961	0,2045303	0,76603606	0,158445322	0,29673799	0,17838265	0,45563426
13	Fila9	0,44986295	0,29158999	0,56821813	0,21937649	0,7241798	0,4743755	0,686755468	0,83959412	0,60432142	0,92421154
14	Fila10	0,94643051	0,58292759	0,82495084	0,37569035	0,38561198	0,84701864	0,822938159	0,24320802	0,74477566	0,29698415

Formulas para buscar con dos criterios

Celda	Formula
C20	=INDICE(C5:L14,,COINCIDIR(C19,C4:L4,0)) INDICE(C5:L14,COINCIDIR(B20,B5:B14,0),)
C22	=INDIRECTO(DIRECCION(COINCIDIR(B20,B$1:B14,0),COINCIDIR(C19,$A4:L4,0)))
C24	=INDICE(C5:L14,COINCIDIR(B20,B5:B14,0),COINCIDIR(C19,C4:L4,0))
C26	=DESREF(B4,COINCIDIR(B20,B5:B14,0),COINCIDIR(C19,C4:L4,0),1,1)
C28	=MAX(INDICE((B5:B14=B20)(C4:L4=C19)C5:L14,0,0))
C30	=SUMAPRODUCTO((C4:L4=C19)(B5:B14=B20)C5:L14)
C32	=BUSCARV(B20,B5:L14,COINCIDIR(C19,B4:L4),0)
C34	{=MAX((B5:B14=B20)(C4:L4=C19)C5:L14)}
C36	=INDIRECTO(B20) INDIRECTO(C19)

Tenga en cuenta el separador de argumentos de acuerdo con la configuración regional de su equipo.
Los { } se obtienen confirmando la fórmula con Ctrl+Mayus+Intro (Ctrl+Shift+Enter).

Seguro hay más soluciones, así que si alguien desea complementar con alguna otra idea ¡pues bienvenido!

Valores correspondientes a ColorIndex

2010-05-14T09:39:00.001-07:00

ColorIndex permite fácilmente aplicar un color a muchos de los objectos en Excel. Obtener la paleta de colores que ofrece colorIndex es muy fácil por medio de una macro. El siguiente código creará una hoja nueva mostrando los colores y su número índice correspondiente:

Sub colores()

    Dim x As Long
    
    With Sheets.Add
    
        For x = 1 To 56
        
            Select Case x
                Case Is < 15
                    .Cells(x, 1).Interior.ColorIndex = x
                    .Cells(x, 2).Value = " --> " & x
                Case Is < 29
                    .Cells(x - 14, 3).Interior.ColorIndex = x
                    .Cells(x - 14, 4).Value = " --> " & x
                Case Is < 43
                    .Cells(x - 28, 5).Interior.ColorIndex = x
                    .Cells(x - 28, 6).Value = " --> " & x
                Case Is < 57
                    .Cells(x - 42, 7).Interior.ColorIndex = x
                    .Cells(x - 42, 8).Value = " --> " & x
            End Select
            
        Next x
        
    End With
    
End Sub

El resultado tras ejecutar la macro:

--> 1	--> 15	--> 29	--> 43
--> 2	--> 16	--> 30	--> 44
--> 3	--> 17	--> 31	--> 45
--> 4	--> 18	--> 32	--> 46
--> 5	--> 19	--> 33	--> 47
--> 6	--> 20	--> 34	--> 48
--> 7	--> 21	--> 35	--> 49
--> 8	--> 22	--> 36	--> 50
--> 9	--> 23	--> 37	--> 51
--> 10	--> 24	--> 38	--> 52
--> 11	--> 25	--> 39	--> 53
--> 12	--> 26	--> 40	--> 54
--> 13	--> 27	--> 41	--> 55
--> 14	--> 28	--> 42	--> 56

Descomprimir un archivo por medio de VBA

2010-05-14T09:38:00.001-07:00

La siguiente función descomprimirá un archivo haciendo uso del programa de compresión de Windows:

Function Descomprimir(ByVal origen As Variant, ByVal destino As Variant) As Boolean

    
    Dim oApp As Object
  
    
    Set oApp = CreateObject("Shell.Application")
    
    Descomprimir = False
    
    
    If VBA.Right(origen, 4) = ".zip" Then
    
        If Not VBA.Right(destino, 1) = Application.PathSeparator Then
            destino = destino & Application.PathSeparator
        End If
  
        On Error GoTo Salir
        oApp.Namespace(destino).CopyHere oApp.Namespace(origen).items
        On Error GoTo 0
        
        Descomprimir = True
        
    End If

Salir:

    Set oApp = Nothing

End Function

Los argumentos origen y destino deben ser de tipo variant cuando se pasan a la función y se refieren a la ruta en la que se encuentra el archivo comprimido y la ruta de la carpeta a la que se quiere descomprimir.

Suponiendo que el archivo que quiero descomprimir es: C:\Users\Mauricio\Documents\Downloads\Prueba.zip

y que lo quiero descomprimir a la carpeta: C:\Users\Mauricio\Documents\Oficina\Informe mensual\

Entonces podría usar algo así (nótese que estoy declarando las rutas de los archivos como variant y no como string):

Sub ejemplo_descomprimir()


    Dim archivo_comprimido As Variant
    Dim carpeta_destino As Variant

     
    archivo_comprimido = "C:\Users\Mauricio\Documents\Downloads\Prueba.zip"
    carpeta_destino = "C:\Users\Mauricio\Documents\Oficina\Informe mensual\"

     
    If Descomprimir(archivo_comprimido, carpeta_destino) Then

        MsgBox "Se ha descomprimido exitosamente el archivo."

    Else

        MsgBox "No se ha logrado descomprimir el archivo."

    End If
     
End Sub

Crear automáticamente copia de un libro de Excel

2010-05-14T09:35:00.001-07:00

La siguiente función creará una copia en la misma ruta del libro que se la pase como argumento, y devolverá el nombre completo y la ruta de la copia creada:

Function crear_copia(ByVal Libro As Excel.Workbook) As String

        With Libro
            .Save
            crear_copia = .Path & Application.PathSeparator & VBA.Format(VBA.Now, "d-m-yy h-mm ") & .Name
            .SaveCopyAs crear_copia
        End With
        
End Function

Para identificar las copias que se vayan creando, se antepondrá al nombre del archivo la fecha y la hora en formato d-m-yy h-mm.

Si se quisiera crear una copia de un libro de Excel cada vez que se abra, bastará con copiar la función en un módulo y en el evento open the Thisworkbook usar algo así:

Private Sub Workbook_Open()

    Dim copia As String
    
    If MsgBox("¿Desea crear una copia del archivo?", vbYesNo) = vbYes Then
        copia = crear_copia(ActiveWorkbook)
        MsgBox "Se ha creado una copia: " & vbLf & copia, vbInformation
    End If
    
End Sub

Acá puede descargar un archivo de prueba con la función crear_copia y la macro en el evento Open de ThisWorkbook para llamarla automáticamente una vez se habiliten las macros: Crear copia.xls

Usar una función definida por el usuario

2010-05-13T21:35:00.001-07:00

Copiar un código de VBA en ThisWorkbook

2010-05-13T21:02:00.001-07:00

Copiar un código de VBA en una hoja

2010-05-13T21:01:00.001-07:00

Copiar un código de VBA en un módulo

2010-05-13T21:00:00.001-07:00

Encontrar el tipo de validación de datos que tiene una celda

2010-05-13T09:08:00.000-07:00

La siguiente función definida por el usuario permite encontrar el tipo de validación de datos que se ha asignado a una celda. Si la celda no tiene validación de datos, la función devolverá 0:

Function Tipo_val(ByVal celda As Excel.Range) As Byte
    
    On Error Resume Next
    Tipo_val = celda.Validation.Type
    On Error GoTo 0

End Function

Los posibles resultados devueltos por la función son los que se presentan en la siguiente tabla:

Tipo_val(Celda)

Validación de datos	Resultado
Cualquier valor	0
Número entero	1
Decimal	2
Lista	3
Fecha	4
Hora	5
Longitud de texto	6
Personalizada	7

Si se quisiera saber si una celda tiene lista de validación de datos, se podría probar algo así:

Sub prueba()

    If Tipo_val(Range("a1")) = 3 Then
        MsgBox "La celda tiene lista de Validación de datos."
    Else
        MsgBox "La celda no tiene lista de Validación de datos."
    End If
    
End Sub

De igual forma, se podría usar directamente en una celda:

=Tipo_Val(A1)

devolviendo el número correspondiente a la validación de datos que tenga la celda A1 (cero si no tiene validación).

Construir un rango dinámico con DESREF

2010-05-11T21:48:00.000-07:00

En Excel se pueden construir rangos dinámicos que se expanden o contraen según la cantidad de datos indicados. Existen diversas formas para construir rangos dinámicos, en el siguiente vídeo se presenta una de las más sencillas haciendo uso de la función DESREF:

En la fórmula inicial:

SUMA(A1:A10)

se usa el rango estático:

A1:A10

que no va a cambiar a menos que lo modifiquemos manualmente.

Para crear el rango dinámico hemos hecho uso de la función Desref, cuya sintaxis es la siguiente:

DESREF(ref;filas;columnas;alto;ancho)

Ref
es la referencia a una celda o a un conjunto de celdas a partir de la(s) cual(es) nos desplazaremos (supongo que de ahí el nombre de la función DesRef: Desplazar referencia).

Filas
es el número de filas que nos desplazaremos, hacia arriba o hacia abajo, a partir de la referencia original (Ref).

Columnas
es el número de columnas que nos desplazaremos, hacia la izquierda o hacia la derecha, a partir de la referencia original.

Estos dos primeros argumentos pueden ser tanto positivos como negativos. Si nuestra celda de referencia es la C5 y nos queremos desplazar a la celda B2, entonces podríamos usar algo así:

Fórmula	Descripción
=DESREF(C5;-3;-1)	Muestra el valor en la celda B2

Los dos últimos argumentos ( Alto y Ancho) son opcionales y si se omiten devolverán el alto o el ancho del rango de referencia:

Alto
es el alto, en número de filas, que se desea que tenga la referencia devuelta.

Ancho
es el ancho, en número de columnas, que se desea que tenga la referencia devuelta.

Tanto el alto como el ancho deben ser un números positivos.

Fórmula	Descripción
=DESREF(A1;0;0;10;1)	Devuelve los valores en el rango A1:A10
=SUMA(DESREF(A1;0;0;10;1))	Suma los valores en el rango A1:A10

Finalmente, para crear el rango dinámico, lo único que necesitamos es ingresar en el Alto la cantidad de datos que queramos tomar, esto lo hacemos por medio de la función CONTARA que nos devuelve el número de celdas no vacías en el rango especificado.

Así, si en la columna A tenemos datos desde la celda A1 hasta la celda A10, la fórmula =CONTARA(A:A) nos devolverá 10. Si tenemos datos desde A1 hasta A17, nos arrojará como resultado 17.

De esta forma, podemos sustituir el Alto por la función CONTARA(A:A).

Fórmula	Descripción
=SUMA(DESREF(A1;0;0;CONTARA(A:A);1))	Suma los valores en el rango A1:A10

Tenga en cuenta que para todas las fórmulas descritas en este artículo he usado el punto y coma ";" como separador de argumentos. Es posible que esto cambie de acuerdo con la configuración regional de su equipo: ¿Por qué no me funciona esta fórmula?

Para más y mejor información, consulte la ayuda de Microsoft Excel sobre la función Desref.

Resaltar la fila de la celda seleccionada en una hoja de Excel

2010-05-10T09:20:00.001-07:00

La siguiente macro de evento resaltará la fila en la que se encuentre de la hoja en la que se copie el código. El resaltado se hace con una autoforma, teniendo la ventaja de no modificar el formato de la celda:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)


    Dim Forma As Excel.Shape
    Dim L#, T#, W#, H#


    Const Columna_inicial   As Long = 1
    Const Columnas          As Long = 6
    Const Grosor_borde      As Byte = 1
    Const Color_borde       As Byte = 5 'Use la paleta de colores de ColorIndex


    With Me.Cells(Target.Row, Columna_inicial).Resize(, Columnas)

        L = .Left
        T = .Top
        W = .Width
        H = .Height

    End With


    With Me.Shapes

        
        On Error Resume Next

            .Item("Resaltado").Delete

        On Error GoTo 0

        
        With .AddShape(1, L, T, W, H)
        
            .Name = "Resaltado"
            .Line.Weight = Grosor_borde
            
            With .DrawingObject
            
                .Interior.ColorIndex = xlNone
                .Border.ColorIndex = Color_borde
                
            End With
            
        End With

        
    End With
    

End Sub

¿Qué hago con este código?

Las constantes Columna_inicial, Columnas, Grosor_borde y Color_borde indican las características que tendrá el resaltado.

El color del borde de la autorforma se genera con ColorIndex, para ver la paleta de color de color index vea este otro tema: ¿Cómo obtener los valores correspondientes a ColorIndex?

Simular barra de progreso en la barra de estado de Excel

2010-05-05T21:07:00.000-07:00

La siguiente subrutina simulará una barra de progreso en la barra de estado de Excel haciendo uso de caracteres Unicode:

Sub barra_de_estado(ByVal Progreso As Byte, ByVal Largo As Byte)

    If Progreso < Largo Then

        Application.StatusBar = VBA.ChrW(9599) & _
                                VBA.String(Progreso, VBA.ChrW(9607)) & _
                                VBA.String(Largo - Progreso, VBA.ChrW(9620)) & _
                                VBA.ChrW(9599) & "  " & _
                                Progreso * (100 / Largo) & "% completado"
    Else

        Application.StatusBar = False

    End If

End Sub

Los argumentos progreso y largo que se pasan a la función indican, respectivamente, el avance de la subrutina y la longitud en caracteres de la barra de progreso que se mostrará.

Si el largo es igual a 20, como en el ejemplo que pondré a continuación, entonces la barra de progreso hará avances de 5% (20 caracteres cada uno de 5% hasta completar el 100%).

Como se ve, la macro hace uso de los caracteres Unicode, por medio de la función ChrW, para simular la barra de progreso. Si se quieren visualizar todos los caracteres Unicode disponibles se podría usar esta macro (y de paso probar la macro que simula la barra de progreso):

Sub Caracteres_ChrW()

    Dim Progreso As Byte
    Dim x As Long

    Const Largo As Byte = 20

    With Sheets("Hoja1")

        For x = 1 To 65535

            .Cells(x, 1) = x
            .Cells(x, 2) = VBA.ChrW(x)

            Progreso = VBA.Int(x / 65535 * Largo)

            barra_de_estado Progreso, Largo

        Next x

    End With

End Sub

Simular barra de progreso.xls

Vincular dos o más tablas dinámicas por Filtro de Informe

2010-05-05T15:42:00.000-07:00

Las macros que se presentan a continuación sirven para vincular por Filtro de Informe a diferentes tablas dinámicas en un mismo libro.

Si tiene varias tablas dinámicas con un filtro en una misma hoja, entonces copie este código en la hoja en la que se encuentran las tablas dinámicas (cambie "MES DE PRODUCCION" por el nombre de su Filtro):

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)

    Dim TablaDinamica As Excel.PivotTable

    Const Filtro As String = "MES DE PRODUCCION"

    On Error GoTo Salir
    Application.EnableEvents = False

    For Each TablaDinamica In ActiveSheet.PivotTables
        TablaDinamica.PivotFields(Filtro).CurrentPage =   Target.PivotFields(Filtro).CurrentPage.Name
    Next TablaDinamica

Salir:

    Application.EnableEvents = True

End Sub

Si la tabla tiene más de un filtro de informe, basta con modificar ligeramente la macro para incorporar tantos filtros como se quiera (he resaltado en gris las líneas que he añadido suponiendo que se ha añadido un nuevo filtro de informe llamado "Cliente"):

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)

    Dim TablaDinamica As Excel.PivotTable

    Const Filtro As String = "MES DE PRODUCCION"
    Const Filtro2 As String = "Cliente"

On Error GoTo Salir
    Application.EnableEvents = False

    For Each TablaDinamica In ActiveSheet.PivotTables
        TablaDinamica.PivotFields(Filtro).CurrentPage = Target.PivotFields(Filtro).CurrentPage.Name
        TablaDinamica.PivotFields(Filtro2).CurrentPage = Target.PivotFields(Filtro2).CurrentPage.Name
    Next TablaDinamica

Salir:

    Application.EnableEvents = True

End Sub

Descargue este archivo para ver estas dos macros en funcionamiento: Ejemplo 1.xls

Si se quiere vincular tablas dinámicas que se encuentran en distintas hojas, habrá que trabajar con el evento Worksheet_PivotTableUpdate de ThisWorkbook, por lo que la siguiente macro de evento se debe copiar en ThisWorkbook y no en una hoja, y vinculará las tablas dinámicas en las hojas llamdas "Principal" y "TablasDinámicas":

Private Sub Workbook_SheetPivotTableUpdate(ByVal Sh As Object, ByVal Target As PivotTable)

    Dim TablaDinamica As Excel.PivotTable
    Const Filtro1 As String = "MES DE PRODUCCION"
    Const Filtro2 As String = "Cliente"

    Application.EnableEvents = False

    On Error Resume Next

    For Each Sh In Sheets(Array("Principal", "TablasDinámicas"))
        For Each TablaDinamica In Sh.PivotTables
            TablaDinamica.PivotFields(Filtro1).CurrentPage = Target.PivotFields(Filtro1).CurrentPage.Name
            TablaDinamica.PivotFields(Filtro2).CurrentPage = Target.PivotFields(Filtro2).CurrentPage.Name
        Next TablaDinamica
    Next Sh

    Application.EnableEvents = True

End Sub

Descargue este archivo para ver esta última macro en funcionamiento: Ejemplo 2.xls

Reducir el tamaño de un archivo de Excel

2010-05-03T19:03:00.000-07:00

Hay una causa en específico que puede afectar considerablemente el tamaño de un archivo: El rango de celdas que Excel guarda como usado en cada hoja.

Se puede encontrar fácilmente la última celda del rango usado presionando Ctrl+Fin en cualquier hoja. El problema es que en muchos casos la 'última celda' está mucho más allá del rango 'real' de celdas usadas. Esto por lo general se debe a aplicar formatos a celdas que luego no se van a usar, lo que hace que luego Excel guarde esas celdas como parte del rango usado y así crece 'misteriosamente' el tamaño del archivo.

Una forma de solucionar el problema consiste en eliminar las celdas que están más allá del rango 'real' usado:

identificar si el rango usado que está guardando Excel sobrepasa el rango realmente usado de la hoja, presionando Ctrl+Fin;
ir a la última fila con datos y eliminar las filas de ahí hacia abajo y luego ir a la última columna con datos y eliminar todas las columnas de ahí en adelante;
finalmente, guardar el archivo así excel guarda un nuevo rango usado en el que están sólo las celdas con datos.

La macro que sigue llevará a cabo dicho proceso:

Sub Limpiar_rangos()
    
    
    Dim hj As Excel.Worksheet
    Dim copia$, ffin&, cfin&, TI&, TF&
    
    
    copia = crear_copia(ActiveWorkbook)
    MsgBox "Se ha creado una copia: " & vbLf & copia, vbInformation
        
        
    With ActiveWorkbook
    
        TI = VBA.FileLen(.FullName)
    
        For Each hj In .Worksheets
        
            ffin = 1
            cfin = 1
        
            With hj
            
                On Error Resume Next
                ffin = .UsedRange.Find(what:="*", _
                                       LookIn:=xlFormulas, _
                                       SearchOrder:=xlByRows, _
                                       SearchDirection:=xlPrevious).Row
                cfin = .UsedRange.Find(what:="*", _
                                       LookIn:=xlFormulas, _
                                       SearchOrder:=xlByColumns, _
                                       SearchDirection:=xlPrevious).Column
                On Error GoTo 0
                
                If .ProtectContents Then
                    If MsgBox("La hoja " & .Name & " se encuentra protegida." & vbLf & vbLf & _
                              "No se podrán limpiar los rangos de esta hoja a menos que se desproteja." _
                              & vbLf & vbLf & "¿Desea desprotegerla antes de continuar?", vbYesNo, _
                              "¡Hoja protegida!") = vbYes Then
                        If Desproteger(hj) Then
                            Limpiar hj, ffin, cfin
                        Else
                            MsgBox "No se ha desprotegido la hoja.", vbCritical, "¡Clave incorrecta!"
                        End If
                    End If
                Else
                    Limpiar hj, ffin, cfin
                End If

            End With
            
        Next hj
        
        .Save
        
        TF = VBA.FileLen(.FullName)
        
    End With
    
        
    MsgBox "Tamaño original: " & VBA.Format(TI, "#,##0") & " bytes." & vbLf & vbLf & _
           "Tamaño final: " & VBA.Format(TF, "#,##0") & " bytes." & vbLf & vbLf & _
           "El archivo se redujo en: " & VBA.Format(TI - TF, "#,##0") & " bytes" & _
           " (" & VBA.FormatPercent(Abs(TI / TF - 1), 2) & ")."
           
    
End Sub
Private Function Desproteger(ByVal hj As Excel.Worksheet) As Boolean
    
    On Error Resume Next
    hj.Unprotect
    Desproteger = Not VBA.CBool(Err.Number)
    On Error GoTo 0
    
End Function
Private Sub Limpiar(ByVal hj As Excel.Worksheet, ByVal ffin As Long, ByVal cfin As Long)

    With hj
            
        With .Range(.Cells(ffin + 1, 1), .Cells(.Rows.Count, 1)).EntireRow
            If .MergeCells = False Then .Clear
        End With
        
        With .Range(.Cells(1, cfin + 1), .Cells(1, .Columns.Count)).EntireColumn
            If .MergeCells = False Then .Clear
        End With
        
    End With
    
End Sub

Al inicio, la macro hace uso de la función crear_copia, que expuse en un tema anterior. Esto porque la macro limpiará rangos de las hojas, existiendo riesgo de pérdida de información valiosa... así, es mejor crear una copia antes de ejecutar la macro. Para poder usar esta macro y la función crear_copia, basta con copiarlas en un módulo y ejecutarlas.

EDITADO (gracias César por tu sugerencia, acá subo el archivo):

Acá puede descargar un archivo en el que he reproducido el problem mencionado. Para reproducirlo, he creado 5 hojas y he aplicado formatos al rango A1:Z10000 de las 5 hojas. Sin embargo, el archivo sólo tiene datos en A1:D10. El tamaño del archivo es descomunal para los pocos datos que se encuentran allí. Puede usted mismo contrastar el rango con datos versus el rango que Excel guarda como usado presionando Ctrl + Fin. Luego de ejecutar la macro verifique nuevamente el rango que ha guardado Excel como usado: Reducir tamaño archivo.xls