Excel 2013 – Funciones no Documentadas

Excel 2013 – Funciones no Documentadas

Son denominadas “funciones no documentadas” aquellas que no figuran en la lista de funciones de la versión de Excel de que se trate y que, sin embargo, se pueden utilizar en su entorno.

En Excel 2013 existen, al menos, dos funciones que no aparecen documentadas y que, sin embargo, son aplicables dentro del conjunto de funciones de éste.

Función – Inglés Función – Español Descripción
DATEDIF SIFECHA Calcula el número de días, meses o años entre dos fechas.

Sintaxis
SIFECHA(fecha_inicial;fecha_final;unidad)

unidad: El tipo de información que desea que se devuelva, donde:
unidad        devuelve

«Y»              El número de años completos en el período.

«M»              El número de meses completos en el período.

«D»              El número de días en el período.

«MD»            La diferencia entre los días en fecha_inicial y fecha_final. Los meses y años de las fechas se pasan por alto.

«YM»            La diferencia entre los meses de fecha_inicial y fecha_final. Los días y años de las fechas se pasan por alto.

«YD»            La diferencia entre los días de fecha_inicial y fecha_final. Los años de las fechas se pasan por alto.

FILES ARCHIVOS Lista los archivos contenidos en una carpeta.

Sintaxis
ARCHIVOS(celda_referencia)

Ver ejemplo en libro Excel.

Ir a FORMULAS > ASIGNAR NOMBRE
Nombre: CarpetaArchivos
Se refiere a:   = ARCHIVOS (Hoja1!$D$4)
Hoja1!$D$4 es la referencia de hoja y celda que contiene el nombre de la carpeta desde la que se listarán los archivos.

Ejemplos de usos (ver archivo Excel que se acompaña)

Celda Función Ejemplo de uso
A2 DATEDIF 01/06/2001 15/08/2002 75 =SIFECHA(D2;E2;»YD»)

 

Celda Función Ejemplo de uso
A4 FILES C:\Users\Ramiro\Desktop\* Informe-1.txt =INDICE(CarpetaArchivos;1)
A5 C:\Users\Ramiro\Desktop\* Informe-1.txt =INDICE(CarpetaArchivos;1)
A6 Informe-2.docx =INDICE(CarpetaArchivos;2)
A7 Become a Microsoft Certified Trainer.docx =INDICE(CarpetaArchivos;3)

Nota: la Carpeta descrita en las celdas D4 y D5 (C:\Users\Ramiro\Desktop*) deberá corresponderse con una Carpeta válida en el ordenador donde se esté ejecutando.

Excel 2013-Funciones No Documentadas

 

 

Office: Rangos Dinámicos en Excel

Rango Dinámico en Microsoft Excel

Para descargar el archivo de ejemplo, pinche en Rha-Olympics-RangoDinamico

En muchas ocasiones resulta provechoso el empleo de Rangos Dinámicos, en especial para el caso de funciones de Excel que emplean rangos como parámetros.

Definamos Rango Dinámico como aquél Rango de datos que abarca un determinado número de filas y de columnas en una determinada Hoja pero que, por la naturaleza de la información que almacena, puede variar de un momento a otro. Esto es, puede cambiar el número de filas y/o el número de columnas asignadas a ese rango en cada momento.

Pongamos, por ejemplo, el rango de datos  sobre los Juegos Olímpicos que se muestra a continuación:

Olympics from Wikipedia
No. Nation Games Gold Silver Bronze Total
1  United States (USA) 26 976 757 666 2.399
2  Soviet Union (URS) 9 395 319 296 1.010
3  Great Britain (GBR) 27 236 272 272 780
4  France (FRA) 27 202 223 246 671
5  China (CHN) 9 201 145 127 473
6  Italy (ITA) 26 198 166 185 549
7  Germany (GER) 15 174 182 217 573
8  Hungary (HUN) 25 167 144 165 476
9  East Germany (GDR) 5 153 129 127 409
10  Sweden (SWE) 26 143 164 176 483
11  Australia (AUS) 27 138 153 180 471
12  Russia (RUS) 5 133 121 142 396

Rango de datos está almacenado en la Hoja de nombre Resultados

Para sumar los datos almacenados en la columna D entre las filas 4 y 15, podemos emplear la fórmula siguiente:

=SUMA(D4:D15), suma las celdas de la columna D comprendidas entre las filas 4 y 15.

 

Una alternativa sería el uso de la fórmula:

 

=SUMA(D:D), en cuyo caso se sumarían todas las filas de la columna D

 

Imaginemos que hemos utilizado la fórmula =SUMA(D4:D15)para calcular la suma de medallas de oro de todos los países en todos los Juegos.

Cuando concluyan los Juegos de Río, que ahora mismo se celebran, nuestro rango de datos deberá ampliarse en una fila más, donde se muestren los resultados de estos Juegos. Así, por tanto, nuestro rango de datos ha variado a D4:D16, y sin embargo la fórmula que empleamos para calcular la suma de las medallas de oro fue =SUMA(D4:D15),por lo que tenemos dos opciones:

  1. o tenemos que modificar constantemente aquellas fórmulas en las que hemos definido rangos estáticos;
  2. o escribimos la fórmula de manera tal que el rango D4:D15 no sea estático, sino que, dinámicamente, se ajuste a la última fila de los datos.

Veamos la utilización práctica de lo descrito anteriormente.

Rango Dinámico
A  B Fórmula asociada a la columna B
Fila inicial 4 =COINCIDIR(«No.»;Resultados!A:A;0)+1   (1)
Fila final 15 =COINCIDIR(0;Resultados!A:A;-1)            (2)
Rango en texto Resultados!A4:A15 =»Resultados!» & «A» & B3 & «:A» & B4       (3)
Aplicar Función sobre Rango Dinámico 78 =SUMA(INDIRECTO(B5))                             (4)

 

  1. La fila inicial del rango de datos la obtenemos aplicando la función (1)

=COINCIDIR(«No.»;Resultados!A:A;0)+1

Se busca la cadena de caracteres “No. “  en la columna A de la Hoja de nombre Resultados y se obtiene la posición que ésta tiene dentro del rango A:A.  A esa posición se le suma 1, para obtener la primera fila de nuestro rango de datos.

  1. Para buscar la fila final del rango de datos, aplicamos la fórmula (2):

=COINCIDIR(0;Resultados!A:A;-1)

La fórmula nos dará la posición de la última celda en la columna A que contiene un valor de tipo numérico (por eso empleamos en el primer parámetro el valor 0). Resultado 15

Nota: Para obtener la posición de la última celda en la columna A que contiene un valor de tipo texto, emplearíamos en lugar del 0, la combinación “*”.

=COINCIDIR(«*»;Resultados!A:A;-1)

  1. Para conformar la cadena de caracteres que identifican al rango que queremos obtener utilizamos la fórmula (3):

 

=»Resultados!» & «A» & B3 & «:A» & B4

 

que no es más que la concatenación de cadenas de caracteres fijas con contenidos de celdas. Obtenemos como resultado, en la celda B5, la cadena de caracteres:

 

Resultados!A4:A15

 

  1. La cadena de caracteres obtenida con anterioridad, representa, en forma de texto, el rango dinámico que hemos construido para su aplicación posterior en una determinada función. Así, en nuestro ejemplo, aplicamos ese rango dinámico sobre la función (4):

 

=SUMA(INDIRECTO(B5))

 

que nos dará como resultado la suma del rango A4:A15 de la hoja de nombre Resultados.

 

Conclusión

El método que hemos explicado en este artículo, podemos aplicarlo para cualquier circunstancia en que un rango no tiene un tamaño fijo, sino que su cantidad de filas puede variar.

Esta solución nos permite no tener que estar modificando fórmulas cada vez que un determinado rango camba de tamaño. Basta con trabajar con este concepto de rango dinámico para que nuestra fórmulas se creen una vez y sean aplicables siempre, independientemente de las variaciones que pueda sufrir el tamaño del rango.

                                                                                                                                                                                                                                                                                                                                                                              

Sintaxis y ejemplos de uso de las funciones utilizadas en este artículo

Función COINCIDIR

Se aplica a: Excel 2016 , Excel 2013 , Excel 2010 , Excel 2007 , Excel 2016 para Mac

Descripción

La función COINCIDIR busca un elemento determinado en un intervalo de celdas y después devuelve la posición relativa de dicho elemento en el rango. Por ejemplo, si el rango A1:A3 contiene los valores 5, 25 y 38, la fórmula =COINCIDIR(25,A1:A3,0)devuelve el número 2, porque 25 es el segundo elemento del rango.

Sintaxis

COINCIDIR(valor_buscado,matriz_buscada, [tipo_de_coincidencia])

La sintaxis de la función COINCIDIR tiene los siguientes argumentos:

  • Valor_buscado Es el valor que desea buscar en matriz_buscada. Por ejemplo, cuando busca un número en la guía telefónica, usa el nombre de la persona como valor de búsqueda, pero el valor que desea es el número de teléfono.
    El argumento de valor_buscadopuede ser un valor (número, texto o valor lógico) o una referencia de celda a un número, texto o valor lógico.
  • Matriz_buscada Es el rango de celdas en que se realiza la búsqueda.
  • Tipo_de_coincidencia Puede ser el número -1, 0 o 1. El argumento tipo_de_coincidencia especifica cómo Excel hace coincidir el valor_buscadocon los valores de matriz_buscada. El valor predeterminado de este argumento es 1.La siguiente tabla describe la manera en que la función encuentra valores basados en la configuración del argumento tipo_de_coincidencia.

 

Tipo_de_coincidencia Comportamiento
1 u omitido COINCIDIR encuentra el mayor valor que es menor o igual que el valor_buscado. Los valores del argumento matriz_buscada se deben colocar en orden ascendente, por ejemplo: …-2, -1, 0, 1, 2, …, A-Z, FALSO, VERDADERO.
0 COINCIDIR encuentra el primer valor que es exactamente igual que el valor_buscado. Los valores del argumento matriz_buscada pueden estar en cualquier orden.
-1 COINCIDIR encuentra el menor valor que es mayor o igual que el valor_buscado. Debe colocar los valores del argumento matriz_buscada en orden descendente, por ejemplo: VERDADERO, FALSO, Z-A, …2, 1, 0, -1, -2, …, etc.

 

  • COINCIDIRdevuelve la posición del valor coincidente dentro de matriz_buscada, no el valor en sí. Por ejemplo, COINCIDIR(«b»,{«a»,»b»,»c»},0) devuelve 2, la posición relativa de «b» dentro de la matriz {«a»,»b»,»c»}.
  • COINCIDIRno distingue entre mayúsculas y minúsculas cuando busca valores de texto.
  • Si COINCIDIRno puede encontrar una coincidencia, devuelve el valor de error #N/A.
  • Si tipo_de_coincidenciaes 0 y valor_buscado es una cadena de texto, puede usar los caracteres comodín de signo de interrogación (?) y asterisco (*)  en el argumento valor_buscado. Un signo de interrogación coincide con cualquier carácter individual; un asterisco coincide con cualquier secuencia de caracteres. Si desea buscar un signo de interrogación o un asterisco real, escriba una tilde (~) antes del carácter.

 

Ejemplo

 

Producto Recuento
Plátanos 25
Naranjas 38
Manzanas 40
Peras 41
     
Fórmula Descripción Resultado
=COINCIDIR(39;B2:B5;1) Como no hay ninguna coincidencia exacta, se devuelve la posición del siguiente valor inferior (38) dentro del rango B2:B5. 2
=COINCIDIR(41;B2:B5;0) La posición del valor 41 en el rango B2:B5. 4
=COINCIDIR(40;B2:B5;-1) Devuelve un error porque los valores del rango B2:B5 no están en orden descendente. #N/A

_______________________________________________________________________________________________________________________________________________________________________________________

Función INDIRECTO

Se aplica a: Excel 2016 , Excel 2013 , Excel 2010 , Excel 2007 , Excel 2016 para Mac

Descripción

Devuelve la referencia especificada por una cadena de texto. Las referencias se evalúan de inmediato para presentar su contenido. Use INDIRECTO cuando desee cambiar la referencia a una celda en una fórmula sin cambiar la propia fórmula.

Sintaxis

INDIRECTO(ref; [a1])

La sintaxis de la función INDIRECTO tiene los siguientes argumentos:

  • Ref Una referencia a una celda que contiene una referencia de tipo A1 o F1C1, un nombre definido como referencia o una referencia a una celda como cadena de texto. Si ref no es una referencia de celda válida, INDIRECTO devuelve el valor de error #¡REF!.
    • Si ref hace referencia a otro libro (una referencia externa), el otro libro debe estar abierto. Si el libro de origen no está abierto, INDIRECTO devolverá el valor de error #¡REF!.Nota Las referencias externas no son compatibles con Excel Web App.
    • Si ref hace referencia a un rango de celdas fuera del límite de filas de 1.048.576 o del límite de columnas de 16.384 (XFD), INDIRECTO devolverá el error #¡REF!.Nota Este comportamiento es diferente al de otras versiones de Excel anteriores a Microsoft Office Excel 2007, que ignoran el límite superado y devuelven un valor.
  • A1 Un valor lógico que especifica el tipo de referencia que contiene la celda ref.
    • Si a1 es VERDADERO o se omite, ref se interpreta como una referencia estilo A1.
    • Si a1 es FALSO o se omite, ref se interpreta como una referencia estilo F1C1.

Ejemplo

Datos
B2 1,333
B3 45
Jorge 10
5 62
Fórmula Descripción Resultado
‘=INDIRECTO(A2) Valor de la referencia en la celda A2. La referencia es a la celda B2, que contiene el valor 1,333. 1,333
‘=INDIRECTO(A3) Valor de la referencia en la celda A3. La referencia es a la celda B3, que contiene el valor 45. 45
‘=INDIRECTO(A4) Puesto que la celda B4 tiene el nombre definido «George,» la referencia al nombre definido es para la celda B4, que contiene el valor 10. 10
‘=INDIRECTO(«B»&A5) Combina «B» con el valor de A5, que es 5. Esto, a su vez, se refiere a la celda B5, que contiene el valor 62. 62

 

Office y Programación: Buscar Nombre con Salario Mínimo. Microsoft Excel y VBA

Nombre con Salario Mínimo

Solución en Excel


Nombre con Salario Mínimo:      =INDICE(B2:B6;COINCIDIR(MIN(F2:F6);F2:F6;0);1)

Solución en VBA

Código VBA que resuelve el mismo problema.

El botón <Buscar Nombre con Salario Mínimo> está asociado a la macro <BuscarNombreConSalarioMinimo> que realiza los procesos de búsqueda del resultado y lo coloca en la celda correspondiente. El botón <Generar Fórmula>  coloca en la celda de resultado, la fórmula Excel correspondiente a la solución.

Nótese que se han aplicado dos soluciones diferentes:

a)    La que busca el NOMBRE con SALARIO MINIMO y coloca el resultado en la celda correspondiente;

b)    La que coloca en la celda correspondiente la fórmula adecuada para que sea el propio Excel quien resuelva la búsqueda.

Option Explicit

Sub BuscarNombreConSalarioMinimo()

   Dim oWorksheet As Worksheet

   Dim oRangoSalarios As Range

   Dim oRangoNombres As Range

   Dim sExpresion As String

   Dim dblValorSalarioMinimo As Double

   Dim dblPosicionRelativaSalarioMinimo As Double

   Dim sNombreResultante As String

     Set oWorksheet = ThisWorkbook.Worksheets(1)

   Set oRangoSalarios = oWorksheet.Range(«F2:F6»)

   Set oRangoNombres = oWorksheet.Range(«B2:B6»)

  

   sExpresion = «MIN(» + oRangoSalarios.Address + «)»

   dblValorSalarioMinimo = Evaluate(sExpresion)

  

   sExpresion = «MATCH(» + CStr(dblValorSalarioMinimo) + _

                           » ,» + oWorksheet.Name + _

                           «!» + oRangoSalarios.Address + «,0)»


dblPosicionRelativaSalarioMinimo = Evaluate(sExpresion)

 

   sExpresion = «INDEX(» + oWorksheet.Name + «!» + _

                                              oRangoNombres.Address + «,» + _

                                             CStr(dblPosicionRelativaSalarioMinimo) + «,1)»

   sNombreResultante = Evaluate(sExpresion)

   oWorksheet.Cells(16, 4) = sNombreResultante

End Sub

 

Sub BuscarNombreConSalarioMinimoFormula()

   Dim oWorksheet As Worksheet

   Dim oRangoSalarios As Range

   Dim oRangoNombres As Range

   Dim sExpresion As String

  

   Set oWorksheet = ThisWorkbook.Worksheets(1)

   Set oRangoSalarios = oWorksheet.Range(«F2:F6»)

   Set oRangoNombres = oWorksheet.Range(«B2:B6»)

  

   sExpresion = «=INDEX(» + oWorksheet.Name + «!» + _

                                                  oRangoNombres.Address + _

                                                 «,MATCH(MIN(» + oWorksheet.Name + «!» + _

                                                 oRangoSalarios.Address + _

                                                 «),» + oWorksheet.Name + «!» + _

                                                 oRangoSalarios.Address + «,0),1)»

   oWorksheet.Cells(16, 6) = sExpresion

End Sub

Office y Programación: Edad Bruta y Edad Neta. Microsoft Excel y VBA

Edad Bruta y Edad Neta

Solución en Excel

Aplicando una secuencia de funciones anidadas, podemos llegar al resultado correcto.

Edad Bruta:               =AÑO(HOY())-AÑO(A4)

Edad Neta:

=SI(AÑO(HOY())>AÑO(A5);SI(MES(HOY())>MES(A5);AÑO(HOY())-AÑO(A5);SI(MES(HOY())<MES(A5);AÑO(HOY())-AÑO(A5)-1;SI(DIA(HOY())>=DIA(A5);AÑO(HOY())-AÑO(A5);AÑO(HOY())-AÑO(A5)-1)));0)

Solución en VBA

Código VBA que resuelve el mismo problema. El botón <Calcular Edades> está asociado a la macro <Calcular_Edades> que a su vez invoca a los procedimientos

< Calcular_Edad_Bruta> y < Calcular_Edad_Neta>.

Nótese que se han aplicado dos soluciones diferentes:

a)    La que calcula las edades y coloca el resultado en la celda correspondiente;

b)    La que coloca en la celda correspondiente la fórmula adecuada para que sea el propio Excel quien resuelva el cálculo.

Option Explicit

Sub Calcular_Edad_Bruta()

   Dim oWorksheet As Worksheet

   Dim dFechaNacimiento As Date

   Set oWorksheet = ThisWorkbook.Worksheets(1)

   dFechaNacimiento = oWorksheet.Cells(13, 1)

   oWorksheet.Cells(13, 3) = Year(Now()) – Year(dFechaNacimiento)

   dFechaNacimiento = oWorksheet.Cells(14, 1)

   oWorksheet.Cells(14, 3) = Year(Now()) – Year(dFechaNacimiento)

End Sub

 

Sub Calcular_Edad_Neta()

   Dim oWorksheet As Worksheet

   Dim dFechaNacimiento As Date

   Set oWorksheet = ThisWorkbook.Worksheets(1)

   dFechaNacimiento = oWorksheet.Cells(13, 1)

   oWorksheet.Cells(13, 5) = F_Edad_Neta(dFechaNacimiento)

   dFechaNacimiento = oWorksheet.Cells(14, 1)

   oWorksheet.Cells(14, 5) = F_Edad_Neta(dFechaNacimiento)

End Sub

 

Function F_Edad_Neta(ByVal pFecha As Date) As Integer

   If Year(Now()) > Year(pFecha) Then

      If Month(Now()) > Month(pFecha) Then

         F_Edad_Neta = Year(Now()) – Year(pFecha)

      Else

         If Month(Now()) < Month(pFecha) Then

            F_Edad_Neta = Year(Now()) – Year(pFecha) – 1

         Else

            If Day(Now()) >= Day(pFecha) Then

               F_Edad_Neta = Year(Now()) – Year(pFecha)

            Else

               F_Edad_Neta = Year(Now()) – Year(pFecha) – 1

            End If

         End If

      End If

   Else

      F_Edad_Neta = 0

   End If

End Function

Sub Calcular_Edades()

   Call Calcular_Edad_Bruta

   Call Calcular_Edad_Neta

End Sub

Rha-Fiat lux

Fiat lux es una locución latina que literalmente significa «Que se haga la luz» o «Sea la luz», y que tiene sus orígenes en la frase hebrea יְהִי אוֹר (yehiy ‘or).

Después de varios años impartiendo cursos de Programación en Visual Basic for Applications (VBA)  y de Microsoft Excel Avanzado en  modos presencial y OnLine-Live, con un estimado de horas que ronda las 1.000; ha llegado el momento de poner a vuestra disposición una nueva modalidad: la Consultoría.

Con este nuevo modo, pretendemos que los clientes que requieran nuestros servicios profesionales puedan dar un salto cualitativo en sus procesamientos de datos (lo que muchas veces se traduce en un increíble aumento de la productividad), de manera que los procesos se automaticen lo más posible y, por tanto, los usuarios queden liberados de las tareas más rutinarias.

A partir de este mes de Marzo comenzamos nuestra andadura en esta modalidad. En sus inicios abarcaremos: Consultorías en Microsoft Excel y en Programación VBA para Microsoft Excel, con dos vertientes de trabajo:

a)   la Consultoría como asesoría en los temas a resolver, pero sin desarrollos por parte nuestra;

b)   la Consultoría que incluye: Análisis y Diseño de la solución, Desarrollo de la solución y Formación en el uso de la solución.

Quedo a la espera de
vuestras consideraciones.

A partir de hoy, Fiat lux.

Un cordial saludo,

Ramiro Hernández Alonso

Licenciado en Cibernética-Matemática

Ingeniero Superior en Informática

 

rhalonso23@yahoo.es

Convertir celdas de una hoja Excel a Hipervínculos

Comparto con vosotros otra necesidad surgida de un curso de Visual Basic for Applications que recientemente impartí.

Los alumnos se enfrentaban al siguiente problema:
Reciben de datos externos, una hoja Excel, en una de cuyas columnas vienen direcciones de correo electrónico (una diferente para cada fila), pero cuyas celdas tienen formato de texto.

El proceso que seguían para convertir esas celdas con formato texto a celdas hipervinculadas era totalmente manual.

Enfrentamos la tarea con una combinación de código propio y macros generadas por el Grabador de Macros de Excel, ajustando éstas últimas a nuestra solución.

El código resultante quedó como sigue:

‘ Procedimiento para probar <ConvetrtirTextoToHipervinculo>.

‘ Solo a fines de prueba.

Sub InvocarConvertirTextoToHipervinculo()

   Call ConvertirTextoToHipervinculo(«Hoja1»,1)

End Sub

 

 ‘ Procedimiento para probar <QuitarHipervinculos>.

‘ Solo a fines de prueba.

Sub InvocarQuitarHipervinculos()

   Dim oHoja As Excel.Worksheet

   Dim oRango As Excel.Range

   Dim lngUltimaFilaRango As Long

   Set oHoja = ThisWorkbook.Worksheets(«Hoja1»)

   lngUltimaFilaRango = oHoja.Cells(Rows.Count, «A»).End(xlUp).Row

   Set oRango = oHoja.Range(«A1:A» & lngUltimaFilaRango)

   Call QuitarHipervinculos(oRango)


ThisWorkbook.Worksheets(«Hoja1»).Cells(1, 1).Select

End Sub

‘ ====================================================================

Sub ConvertirTextoToHipervinculo(ByVal pNombreHoja As String, _

                                                        ByVal pNumeroColumnaHipervinculo As Integer)

     Dim oHoja As Excel.Worksheet

     Dim lngUltimaFilaRango As Long

     Dim sLetraColumnaHipervinculo As String

      Dim i As Long

     Set oHoja = ThisWorkbook.Worksheets(pNombreHoja)

   sLetraColumnaHipervinculo = _

           ConvertirNumeroColumaToLetraColumna(pNumeroColumnaHipervinculo)

   lngUltimaFilaRango = oHoja.Cells(Rows.Count, _

                                           sLetraColumnaHipervinculo).End(xlUp).Row

  

   For i = 2 To lngUltimaFilaRango

      oHoja.Hyperlinks.Add Anchor:= _

                    oHoja.Cells(i, pNumeroColumnaHipervinculo), _

                   Address:= _

                  «mailto:» & CStr(oHoja.Cells(i, pNumeroColumnaHipervinculo).Value), _

                   TextToDisplay:= _

                   oHoja.Cells(i, pNumeroColumnaHipervinculo).Value

   Next i

End Sub

 

Sub QuitarHipervinculos(ByVal pRango As Excel.Range)

    pRango.Hyperlinks.Delete

End Sub

 

Function ConvertirNumeroColumaToLetraColumna(ByVal pNumeroColumna As 

                                                                                                Integer) As String

   Dim sLetraColumna As String

   sLetraColumna = Cells(1, pNumeroColumna).Address(True, False)

   sLetraColumna = Replace(sLetraColumna, «$1», «»)

   ConvertirNumeroColumaToLetraColumna = sLetraColumna

End Function

Acceder a Access desde Excel mediante VBA

En un reciente curso de Microsoft Access 2010, los alumnos –conocedores de mi preferencia por la programación- me pidieron que hiciera un giro en el temario del curso y lo orientara hacia sus necesidades fundamentales: enlazar bases de datos Access con libros Excel. Así, surgió la necesidad de desarrollar un conjunto procedimientos (la gran mayoría de ellos del tipo FUNCTION).

Para compartir esta información, pongo ese código a la disposición de quién lo necesite.

‘ =================================================================

‘ Para trabajar con ADO, se requiere añadir la referencia:

‘      Microsoft ActiveX Data Objects x.y Library

‘ Para trabajar con ADOX,se requiere añadir la referencia a:

‘      Microsoft ADO Ext. x.y for DDL and Security

‘ Para trabajar con Access.Application,se requiere añadir la referencia a:

‘      Microsoft Access x.y Object Library

‘ Para trabajar con DAO, se requiere añadir la referencia a:

‘      Microsoft DAO x.y Object Library

‘ ====================================================================

Function ReadAccessTableToExcel(ByVal pAccessDatabaseFullName As String, _

                                                    ByVal pAccessTableName As String, _

                                                    ByVal pExcelWorkbookFullName As String, _

                                                    ByVal pExcelTargetSheetName As String) As Boolean

    Dim oConnection  As ADODB.Connection

    Dim oRecordset   As ADODB.Recordset

    Dim oWorkbook  As Workbook

    Dim oWorksheet As Worksheet

    Dim i  As Integer

     On Error GoTo TError

     Set oConnection = New ADODB.Connection

     oConnection.Open «Provider=Microsoft.Ace.OLEDB.12.0; » & _ 

                                        «Data Source=» & pAccessDatabaseFullName

    Set oRecordset = New ADODB.Recordset

    oRecordset.Open pAccessTableName, oConnection, _ 

                                    adOpenKeyset, adLockOptimistic, adCmdTable

    If FileExist(pExcelWorkbookFullName) = False Then

       Set oWorkbook = Application.Workbooks.Add

    Else

       Set oWorkbook = Application.Workbooks.Open(pExcelWorkbookFullName)

    End If

    If SheetExist(oWorkbook, pExcelTargetSheetName) = False Then

       Set oWorksheet = oWorkbook.Worksheets.Add

       oWorksheet.Name = pExcelTargetSheetName

    Else

       Set oWorksheet = oWorkbook.Worksheets(pExcelTargetSheetName)

    End If

    oWorksheet.UsedRange.Clear

    For i = 0 To oRecordset.Fields.Count – 1

        oWorksheet.Range(«A1»).Offset(, i).Value = oRecordset.Fields(i).Name

    Next i

 

    oWorksheet.Range(«A1»).Resize(, oRecordset.Fields.Count).Font.Bold = True

     oWorksheet.Range(«A2»).CopyFromRecordset oRecordset


Application.DisplayAlerts = False

     oWorkbook.SaveAs (pExcelWorkbookFullName)

     oWorkbook.Close

     Application.DisplayAlerts = True

   
oRecordset.Close

    Set oRecordset = Nothing

     oConnection.Close

    Set oConnection = Nothing

    ReadAccessTableToExcel = True

    Exit Function

TError:

    If Not (oRecordset Is Nothing) Then

       If (oRecordset.State And adStateOpen) = adStateOpen Then oRecordset.Close

       Set oRecordset = Nothing

    End If

    If oConnection.State = adStateOpen Then oConnection.Close

    ReadAccessTableToExcel = False

End Function

 

‘ ====================================================================

‘ ====================================================================

Function ReadAccessSQLToExcel(ByVal pAccessDatabaseFullName As String, _

                                                    ByVal pSQLSentence As String, _

                                                   ByVal pExcelWorkbookFullName As String, _

                                                   ByVal pExcelTargetSheetName As String) As Boolean

     Dim oConnection As ADODB.Connection

    Dim oRecordset  As ADODB.Recordset

    Dim sConnection As String

    Dim oWorkbook   As Workbook

    Dim oWorksheet  As Worksheet

    Dim i  As Long

   

    On Error GoTo TError

    Set oConnection = CreateObject(«ADODB.Connection»)

    sConnection = «Provider=Microsoft.ACE.OLEDB.12.0;» & _

                               «Data Source=» & pAccessDatabaseFullName

    oConnection.Open sConnection

    Set oRecordset = oConnection.Execute(pSQLSentence)

    If FileExist(pExcelWorkbookFullName) = False Then

       Set oWorkbook = Application.Workbooks.Add

    Else

       Set oWorkbook = Application.Workbooks.Open(pExcelWorkbookFullName)

    End If

    If SheetExist(oWorkbook, pExcelTargetSheetName) = False Then

       Set oWorksheet = oWorkbook.Worksheets.Add

       oWorksheet.Name = pExcelTargetSheetName

    Else

       Set oWorksheet = oWorkbook.Worksheets(pExcelTargetSheetName)

    End If

    Set oWorksheet = oWorkbook.Worksheets(pExcelTargetSheetName)

    oWorksheet.UsedRange.Clear

    For i = 0 To oRecordset.Fields.Count – 1

        oWorksheet.Range(«A1»).Offset(, i).Value = oRecordset.Fields(i).Name

    Next i


oWorksheet.Range(«A1»).Resize(,
oRecordset.Fields.Count).Font.Bold = True

    oWorksheet.Range(«A2»).CopyFromRecordset oRecordset

    Application.DisplayAlerts = False

    oWorkbook.SaveAs (pExcelWorkbookFullName)

    oWorkbook.Close

    Application.DisplayAlerts = True

    oRecordset.Close

    Set oRecordset = Nothing

    oConnection.Close

    Set oConnection = Nothing

    ReadAccessSQLToExcel = True

    Exit Function

TError:

    If Not (oRecordset Is Nothing) Then

       If (oRecordset.State And adStateOpen) = adStateOpen Then oRecordset.Close

         Set oRecordset = Nothing

    End If

    If oConnection.State = adStateOpen Then oConnection.Close

    ReadAccessSQLToExcel = False

 End Function

 

Function GetAccessTableNames(ByVal pAccessDatabaseFullName As String) _

                                                         As String()

     Dim oConnection       As ADODB.Connection

    Dim oCatalog          As ADOX.Catalog

    Dim oTable            As ADOX.Table

    Dim sConnectionString As String

    Dim arrTableNames()   As String

    Dim i                 As Long

    On Error GoTo TError

    sConnectionString = «Provider=Microsoft.ACE.OLEDB.12.0;» & _

                                         «Data Source=» & pAccessDatabaseFullName

   Set oConnection = New ADODB.Connection

    oConnection.Open sConnectionString

    Set oCatalog = New ADOX.Catalog

    Set oCatalog.ActiveConnection = oConnection

    i = -1

    For Each oTable In oCatalog.Tables

       If oTable.Type = «TABLE» Then

          i = i + 1

          ReDim Preserve arrTableNames(i)

           arrTableNames(i) = oTable.Name

       End If

    Next oTable

    oConnection.Close

    Set oCatalog = Nothing

    Set oConnection = Nothing

    GetAccessTableNames = arrTableNames

    Exit Function

TError:

    If oConnection.State = adStateOpen Then oConnection.Close

End Function

Function GetAccessTableFieldNames(ByVal pAccessDatabaseFullName As String, _

                                                      ByVal pAccessTableName As String) As String()

    Dim oConnection     As ADODB.Connection

    Dim oRecordset      As ADODB.Recordset

    Dim arrFieldNames() As String

    Dim i               As Long

    On Error GoTo TError

     Set oConnection = New ADODB.Connection

     oConnection.Open «Provider=Microsoft.Ace.OLEDB.12.0; » & _ 

                                       «Data Source=» & pAccessDatabaseFullName

    Set oRecordset = New ADODB.Recordset

    oRecordset.Open pAccessTableName, oConnection, _

                                   adOpenKeyset, adLockOptimistic, adCmdTable

    For i = 0 To oRecordset.Fields.Count – 1

        ReDim Preserve arrFieldNames(i)

        arrFieldNames(i) = oRecordset.Fields(i).Name

    Next i

    oRecordset.Close

    Set oRecordset = Nothing

    oConnection.Close

    Set oConnection = Nothing

    GetAccessTableFieldNames = arrFieldNames

    Exit Function

TError:

    If Not (oRecordset Is Nothing) Then

       If (oRecordset.State And adStateOpen) = adStateOpen Then oRecordset.Close

       Set oRecordset = Nothing

    End If

    If oConnection.State = adStateOpen Then oConnection.Close

End Function

Function GetAccessTableFieldTypes(ByVal pAccessDatabaseFullName As String, _

                                                        ByVal pAccessTableName As String) As String()

    Dim oConnection      As ADODB.Connection

    Dim oRecordset       As ADODB.Recordset

    Dim arrFieldTypes()  As String

    Dim i                As Long

     On Error GoTo TError

     Set oConnection = New ADODB.Connection

     oConnection.Open «Provider=Microsoft.Ace.OLEDB.12.0; » & _

                                       «Data Source=» & pAccessDatabaseFullName

    Set oRecordset = New ADODB.Recordset

    oRecordset.Open pAccessTableName, oConnection, _

    adOpenKeyset, adLockOptimistic, adCmdTable

    For i = 0 To oRecordset.Fields.Count – 1

        ReDim Preserve arrFieldTypes(i)

        arrFieldTypes(i) = TypeName(oRecordset.Fields(i).Value)

    Next i

    oRecordset.Close

    Set oRecordset = Nothing

    oConnection.Close

    Set oConnection = Nothing

    GetAccessTableFieldTypes = arrFieldTypes

    Exit Function

TError:

    If Not (oRecordset Is Nothing) Then

       If (oRecordset.State And adStateOpen) = adStateOpen Then oRecordset.Close

       Set oRecordset = Nothing

    End If

    If oConnection.State = adStateOpen Then oConnection.Close

 End Function

 

Function GetAccessTableFieldValues(ByVal pAccessDatabaseFullName As String, _

                                                                   ByVal pAccessTableName As String, _

                                                                  ByVal pFieldName As String) As Variant()

    Dim oConnection      As ADODB.Connection

    Dim oRecordset       As ADODB.Recordset

    Dim arrFieldValues() As Variant

    Dim i                As Long

    On Error GoTo TError

    Set oConnection = New ADODB.Connection

    oConnection.Open «Provider=Microsoft.Ace.OLEDB.12.0; » & _

                                       «Data Source=» & pAccessDatabaseFullName

    Set oRecordset = New ADODB.Recordset

    oRecordset.Open pAccessTableName, oConnection, _

                                   adOpenKeyset, adLockOptimistic, adCmdTable

    ReDim arrFieldValues(oRecordset.RecordCount – 1)

    i = -1

    Do While Not oRecordset.EOF

       i = i + 1

       arrFieldValues(i) = oRecordset.Fields(pFieldName).Value

       oRecordset.MoveNext

    Loop

    oRecordset.Close

    Set oRecordset = Nothing

    oConnection.Close

    Set oConnection = Nothing

    GetAccessTableFieldValues = arrFieldValues

    Exit Function

TError:

    If Not (oRecordset Is Nothing) Then

       If (oRecordset.State And adStateOpen) = adStateOpen Then oRecordset.Close

       Set oRecordset = Nothing

    End If

    If oConnection.State = adStateOpen Then oConnection.Close

End Function

 

Function GetAccessQueryNames_1(ByVal pAccessDatabaseFullName As String) _

                                                                As String()

    Dim sConnectionString As String

    Dim oConnection       As ADODB.Connection

    Dim oCatalog          As ADOX.Catalog

    Dim oView             As ADOX.View

    Dim arrQueryNames()   As String

    Dim i                 As Long

    On Error GoTo TError

     sConnectionString = «Provider=Microsoft.ACE.OLEDB.12.0;» & _

                                          «Data Source=» & pAccessDatabaseFullName

    Set oConnection = New ADODB.Connection

     oConnection.Open sConnectionString

    Set oCatalog = New ADOX.Catalog

    Set oCatalog.ActiveConnection = oConnection

     i = -1

    For Each oView In oCatalog.Views

       i = i + 1

       ReDim Preserve arrQueryNames(i)

       arrQueryNames(i) = oView.Name

    Next oView  

    oConnection.Close

    Set oCatalog = Nothing

    Set oConnection = Nothing

    GetAccessQueryNames_1 = arrQueryNames

    Exit Function

TError:

    If oConnection.State = adStateOpen Then oConnection.Close

End Function

 

Function GetAccessQueryNames_2(ByVal pAccessDatabaseFullName As String) _

                                                                As  String()

    Dim  oDatabase       As DAO.Database

    Dim oQueryDef       As DAO.QueryDef

    Dim arrQueryNames() As String

    Dim i               As Long

    On Error GoTo TError

    Set oDatabase = DBEngine.OpenDatabase(pAccessDatabaseFullName)

    i = -1

    For Each oQueryDef In oDatabase.QueryDefs

       If Mid(oQueryDef.Name, 1, 1) <> «~» Then

          i = i + 1

          ReDim Preserve arrQueryNames(i)

          arrQueryNames(i) = oQueryDef.Name

       End If

    Next


oQueryDef.Close

    Set oQueryDef = Nothing

    oDatabase.Close

    Set oDatabase = Nothing

    GetAccessQueryNames_2 = arrQueryNames

    Exit Function

  TError:

    On Error Resume Next

    oQueryDef.Close

    On Error Resume Next

    oDatabase.Close

End Function

 

Function GetAccessQuerySELECTFromQueryName(ByVal pAccessDatabaseFullName As String, _

                                   ByVal pAccessQueryName As String) As String

    Dim oDatabase As DAO.Database

    Dim oQueryDef As DAO.QueryDef

    On Error GoTo TError

    Set oDatabase = DBEngine.OpenDatabase(pAccessDatabaseFullName)

    Set oQueryDef = oDatabase.QueryDefs(pAccessQueryName)

    GetAccessQuerySELECTFromQueryName = oQueryDef.Sql

    oDatabase.Close

    Set oDatabase = Nothing

    Exit Function

TError:

    On Error Resume Next

    oDatabase.Close

    GetAccessQuerySELECTFromQueryName = «»

End Function

 

Function ExecuteAccessQueryName(ByVal pAccessDatabaseFullName As String, _

                                          ByVal pAccessQueryName As String) As ADODB.Recordset

    Dim sConnectionString As String

    Dim oConnection       As ADODB.Connection

    Dim oRecordset        As ADODB.Recordset

    Dim sSQL              As String

    On Error GoTo TError

    sConnectionString = «Provider=Microsoft.ACE.OLEDB.12.0;» & _

                                         «Data Source=» & pAccessDatabaseFullName

    Set oConnection = New ADODB.Connection

    oConnection.Open sConnectionString

    sSQL = GetAccessQuerySELECTFromQueryName(pAccessDatabaseFullName, _
pAccessQueryName)

    Set oRecordset = oConnection.Execute(sSQL)                          

    Set ExecuteAccessQueryName = oRecordset

    Set oRecordset = Nothing

    Exit Function

TError:

    On Error Resume Next

    Set oRecordset = Nothing

    Set ExecuteAccessQueryName = Nothing

End Function

 

Function ExecuteAccessQuerySELECT(ByVal pAccessDatabaseFullName As String, _

                                       ByVal pAccessQuerySELECT As String) As ADODB.Recordset

    Dim sConnectionString As String

    Dim oConnection       As New ADODB.Connection

    Dim oRecordset        As New ADODB.Recordset

    Dim oCommand          As New ADODB.Command

    On Error GoTo TError

    sConnectionString = «Provider=Microsoft.ACE.OLEDB.12.0;» & _

                                         «Data Source=» & pAccessDatabaseFullName

    oConnection.Open sConnectionString

    oCommand.CommandType = adCmdText

    oCommand.CommandText = pAccessQuerySELECT

    oCommand.ActiveConnection = oConnection

    Set oRecordset = oCommand.Execute()

    Set ExecuteAccessQuerySELECT = oRecordset

    Set oCommand = Nothing

    Set oRecordset = Nothing

    oConnection.Close

    Set oConnection = Nothing

    Exit Function

TError:

    If Not (oRecordset Is Nothing) Then

       If (oRecordset.State And adStateOpen) = adStateOpen Then oRecordset.Close

       Set oRecordset = Nothing

    End If

    If oConnection.State = adStateOpen Then oConnection.Close

    Set ExecuteAccessQuerySELECT = Nothing

End Function