AGREGAR INFORMACIÓN DEL PROCESO REALIZADO EN LA EJECUCIÓN DE UNA MACRO O UN PROGRAMA EN VBA

Hola a todos 🙂

Hace unos días estuve implementado un proceso en VBA que duraba varios minutos (incluso programándolo de la forma más eficiente).

Esto me hizo reflexionar acerca de la conveniencia de agregar algún tipo de indicado que me mostrase de alguna manera el procentaje de trabajo realizado por la macro.

Lo que no quería era insertar una barra de progreso, (crear un userform, el insertar una etiqueta, un frame y programarlo todo). Pero recordé que con el uso de la propiedad Application.StatusBar (barra de estado), podría crear una sencilla línea de código que me mostrase lo que necesitaba.

Os lo explico con un ejemplo, voy a recurrir a un pequeño ejercicio que publiqué en su día sobre cómo buscar con varios criterios en VBA. En ese proceso utilizábamos varias
instrucciones for-next  y eso nos vendrá muy bien para programar nuestra barra de estado.

En el ejemplo tenemos una hoja (TABLABASE) con la información de los automóviles matriculados en España hasta abril 2016, según marca, tipo de combustible y Comunidad Autónoma de residencia. Y en otra hoja (DATOS), la misma información pero solo de los automóviles diesel. El ejercicio es buscar la información en la tabla principal siguiendo los tres primeros criterios y añadiendo el total en la columna Datos:

AGREGAR INFORMACION DEL PROCESO REALIZADO EN LA EJECUCI0N DE UNA MACRO O UN PROGRAMA EN VBA

Voy a conservar el mismo código que en el del post anterior y añadiré la nueva línea de código que hará lo que estamos buscando (resalto en azul):

Sub BUSCAR_INDICADOR_DE_PROGRESO()
'Declaramos variables
Dim i As Double
Dim j As Double
Dim Marca As String, Carburante As String, Comunidad As String
'Desactivamos actualización de pantalla
Application.ScreenUpdating = False
'Refrescamos la columna de total por cada búsqueda que hagamos
With Worksheets("DATOS")
Total = Application.CountA(.Range("D:D"))
If Total > 1 Then .Range("D2:D" & Total).ClearContents
End With
'Definimos rango de tablabase
fin = Application.CountA(Worksheets("TABLABASE").Range("A:A"))
'Definimos rango de datos
Final = Application.CountA(Worksheets("DATOS").Range("A:A"))
With Worksheets("TABLABASE")
'Iniciamos el bucle principal en tabla Datos
For i = 2 To Final
'Definimos cada uno de los Items por los que vamos a buscar
Marca = Sheets("DATOS").Cells(i, 1)
Carburante = Sheets("DATOS").Cells(i, 2)
Comunidad = Sheets("DATOS").Cells(i, 3)
'Segundo bucle en tablabase por cada item del primer bucle
For j = 2 To fin
'Buscamos con un condicional en tablabase cada una de las variables definidas
If Marca = .Cells(j, 1) And _
Carburante = .Cells(j, 2) And _
Comunidad = .Cells(j, 3) Then
'si encontramos coincidencia, igualamos celdas con el valor de la columna 4
Sheets("DATOS").Cells(i, 4) = .Cells(j, 4)
Exit For
End If
Next
'Insertamos mensaje en barra de tareas para mostrar % completo de la ejecución de la macro
Application.StatusBar = "Progreso: " & i & " de " & Final & " Porcentaje completado: " & Format(i / Final, "0%")
Next
End With
Application.ScreenUpdating = True
End Sub

Como podéis observar, nos ayudamos con los datos del primer bucle for-next dado que es el proceso principal (va recorriendo cada línea) y nos muestra la información de cual es el registro que está en uso (la variable “i”) y cual es el número total de registros que nuestro proceso debe recorrer (variable “Final”).

Con esa información ya podemos confeccionar nuestra barra de esta perfectamente:

Application.StatusBar = "Progreso: " & i & " de " & Final & " Porcentaje completado: " & Format(i / Final, "0%")

Una vez que ejecutemos la macro nos mostrará el proceso de esta forma:

AGREGAR INFORMACION DEL PROCESO REALIZADO EN LA EJECUCI0N DE UNA MACRO O UN PROGRAMA EN VBA1

La clave es disponer de variables numéricas que nos permitan expresar los datos en %, y colocar el código en el bucle correspondiente (que debe ser el principal o el que de alguna forma nos pueda indicar el progreso de nuestro código). No tendrá sentido usar esta propiedad en macros que se ejecutan en pocos segundos.

Pues eso es todo, estoy seguro que os será de utilidad 🙂

Descarga el archivo de ejemplo pulsando en: AGREGAR INFORMACIÓN DEL PROCESO REALIZADO EN LA EJECUCIÓN DE UNA MACRO O UN PROGRAMA EN VBA

 

Anuncios

ESTRUCTURA SELECT CASE PARA REEMPLAZAR CARACTERES EN UNA CADENA DE TEXTO O NÚMEROS

Hola a todos:

Hace unos días respondí a una consulta en la que un lector me preguntaba sobre la forma de incorporar a un proceso un código que pudiese reemplazar determinados caracteres, por ejemplo: la ñ por la n.

La aplicación que estaba desarrollando iniciaba consultas a internet y necesitaba controlar que estos caracteres se reemplazasen por los que él indicaba. Además también necesitaba hacer algunas modificaciones con otros datos en los que debía reemplazar algunos números por otros.

Para realizar esta tarea, opté por hacer uso de una estructura Select Case, dado que me permitía realizar todo lo que me pedía.

Veámoslo con un ejemplo sencillo, tenemos varias informaciones en las cuatro primeras líneas:

ESTRUCTURA SELECT CASE PARA REEMPLAZAR CARACTERES EN UNA CADENA DE TEXTO O NUMERO

Para el primer caso, se necesita cambiar la ñ por una n, en los siguientes casos, si los números son el 1, el 2 o el 3, debemos mostrar un 1, si son el 4, el 5 o el 6 debemos mostrar un 2 y si son el 7, el 8 o el 9, un 3. Y en la última fila varios números combinamos.

Pues bien, para hacer este ejercicio vamos a utilizar la siguiente macro:

Sub EJEMPLO_SELECT_CASE()
'Definimos variables
Dim sDato As String, nItem As String
Dim i As Integer, j As Integer, sLargo As Integer
With Sheets("DATOS")
Final = Application.CountA(.Range("A:A"))
'Iniciamos bucle por cada celda de la columna A
For i = 2 To Final
sLargo = Len(.Cells(i, 1))
'Si hay datos entonces iniciamos segundo bucle
If sLargo > 0 Then
'Extraemos cada carácter de la celda seleccionada
For j = 1 To sLargo
nItem = Mid(.Cells(i, 1), j, 1)
'Iniciamos estructura Select Case
Select Case nItem
Case "Ñ"
nItem = "N"
Case "ñ"
nItem = "n"
Case 0 To 3
nItem = "1"
Case 4 To 6
nItem = "2"
Case 7 To 9
nItem = "3"
End Select
'Agrupamos de nuevo la palabra
sDato = sDato & nItem
Next j
End If
'Pasamos el dato a la columna B
.Cells(i, 2) = sDato
'Igualamos Sdato a 0
sDato = 0
'Seguimos con la próxima palabra/string
Next i
End With
End Sub

Como podéis observar, tenemos varios bucles for – next, uno para recorrer las filas y otro para recorrer la cadena de texto dentro de esa fila.

A continuación aplicamos el Select Case que hemos programado según los parámetros requeridos, cambiar la ñ por la n (también si es mayúscula) y por grupo de números para obtener este resultado:

ESTRUCTURA SELECT CASE PARA REEMPLAZAR CARACTERES EN UNA CADENA DE TEXTO O NUMERO1

Como podéis observar, los cambios se realizan según lo esperado, y podríamos seguir añadiendo condiciones o (casos) a nuestro Select según nuestras necesidades.

Y esto ha sido todo, espero que os sea de utilidad 🙂

Descarga el archivo de ejemplo pulsando en: ESTRUCTURA SELECT CASE PARA REEMPLAZAR CARACTERES EN UNA CADENA DE TEXTO O NÚMERO

 

CONSOLIDAR VARIOS ARCHIVOS CSV O TXT USANDO CONEXIÓN DE DATOS EXTERNOS Y VBA

Hola a todos 🙂

Espero que todo os vaya bien!

La verdad es que llevo unas semanas con un montón de consultas y como siempre con muy poco tiempo disponible. Muchos de vosotros estáis buscando formas y métodos para hacer de vuestro trabajo una experiencia mucho más eficiente y fiable.

La programación es sin duda la forma de hacerlo!. Hoy volvemos parcialmente sobre un tema ampliamente tratado en este blog, la consolidación o agrupación de archivos de Excel (en este post tenéis acceso a las publicaciones relacionadas: AGRUPAR INFORMACIÓN DE VARIOS LIBROS EN UNA HOJA EXCEL).

Pero hoy la diferencia es que vamos a consolidar información de varios archivos CSV (archivos delimitados por comas) y que también nos va a servir para archivos de texto (TXT).

Tuve mis dudas sobre el método a utilizar, pero finalmente me he inclinado por usar en parte una de las herramientas predefinidas en Excel: Conectarse con datos externos (Importar) y hacer así la tarea un poco más rápida.

La razón de escribir este post se debe a una consulta recibida estos últimos días donde un lector preguntaba cómo podía consolidar la información de varios archivos CSV en una sola hoja de Excel, obviamente cada campo separado por comas en una columna.

Como siempre, vamos a utilizar un pequeño ejemplo: imaginad que tenemos cuatro archivos CSV:

EJEMPLOS_CONSOLIDAR VARIOS ARCHIVOS CSV O TXT USANDO CONEXION DE DATOS EXTERNOS Y VBA

En el que consta la información de cuatro grupos de estudiantes en los que se describe: ID, NOMBRE, CLASE, ASIGNATURAS Y CALIFICACIONES, y la coma es el delimitador de cada campo:

EJEMPLOS_CONSOLIDAR VARIOS ARCHIVOS CSV O TXT USANDO CONEXION DE DATOS EXTERNOS Y VBA1

Pues bien, para poder realizar este trabajo, vamos a usar la siguiente macro:

Sub IMPORTAR_CSV()
'Definimos Variables
Dim Consulta As QueryTable, nArchivos As Variant, j As Long, i As Long
Dim uFila As Long, Conexiones As Object
'Seleccionamos archivos
nArchivos = Application.GetOpenFilename(FileFilter:="Text Files (*.CSV),*.CSV", _
Title:="Seleccionar archivos a importar", MultiSelect:=True)
'Si no seleccionamos nada, salimos del proceso
If IsArray(nArchivos) = False Then Exit Sub
'Dimensionamos datos
For j = LBound(nArchivos) To UBound(nArchivos)
nArchivos(j) = "TEXT;" & nArchivos(j)
Next j
For j = LBound(nArchivos) To UBound(nArchivos)
'Comprobamos la última fila con datos de la columna A
With Sheets("CONSOLIDADO")
If Application.CountA(.Range("A:A")) = 0 Then
uFila = 1
Else
uFila = Application.CountA(.Range("A:A")) + 1
End If
'Iniciamos la consulta
Set Consulta = .QueryTables.Add(Connection:=nArchivos(j), Destination:=.Range("A" & uFila))
'Indicamos parámetros de la consulta que nos interesan:
With Consulta
.Name = "Datos"
.FieldNames = True
.PreserveFormatting = True
.RefreshStyle = xlInsertDeleteCells
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileCommaDelimiter = True
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End With
Next j
'Eliminamos todas las conexiones que hemos iniciado.
For Each Conexiones In ActiveWorkbook.Connections
Conexiones.Delete
Next Conexiones
End Sub

Como podéis observar, estamos utilizando una consulta (querytables) para importar la información y colocarla según el delimitador que tenemos, que en este caso es una coma. Si fuese punto y coma  por que es un texto, bastaría sustituir en la macro:

.TextFileCommaDelimiter = True

por esto:

.TextFileSemicolonDelimiter = True

Y donde ponemos CSV en Application.GetOpenFilename poner TXT. Pero como estamos tratando con archivos CSV, dejamos la coma.

Una vez que ejecutamos la macro, la información consolidada quedaría así:

EJEMPLOS_CONSOLIDAR VARIOS ARCHIVOS CSV O TXT USANDO CONEXION DE DATOS EXTERNOS Y VBA2

Como podéis ver, hemos agrupado todos los archivos, según los especificado en los CSV y en el código.

OJO La parte final de la macro elimina todas las conexiones del libro y por lo tanto todas las que hemos creado para importar la información.

For Each Conexiones In ActiveWorkbook.Connections
Conexiones.Delete
Next Conexiones

Aunque lo normal es dejar las conexión por si las queremos actualizar, en este caso no tiene sentido dado que estamos consolidando informaciones de muchos ficheros y además supondría tener cientos de conexiones en la archivo, por ejemplo, en este, sin eliminarlas se verían así:

EJEMPLOS_CONSOLIDAR VARIOS ARCHIVOS CSV O TXT USANDO CONEXION DE DATOS EXTERNOS Y VBA3

Si las queréis conservar, simplemente eliminad esa parte de la macro o dejadla como está, pero tened en cuenta que borra todas las conexiones del libro.

Sobre los parámetros, vosotros mismos podéis configurarlos, o bien consultáis en el soporte de microsoft sobre el objeto QueryTables o con el grabador de macros, grabáis una importación y añadís a la macro las especificaciones que necesitéis.

Y esto es todo, os dejo la macro para que la probéis y espero que en algún momento os sea de utilidad.

 

Descarga el archivo de ejemplo pulsando en: CONSOLIDAR VARIOS ARCHIVOS CSV O TXT USANDO CONEXIÓN DE DATOS EXTERNOS Y VBA

Los archivos de prueba los subo en una carpeta a Google Drive: ARCHIVOS DE EJEMPLO PARA PRUEBAS

DESCOMPRIMIR ARCHIVOS .ZIP DESDE EXCEL CON VBA

Hola a todos!

En nuestro trabajo es muy habitual que recibamos archivos con extensión .zip, es decir, que han sido comprimidos previamente para reducir su tamaño y poder así enviarlos más fácilmente.

Aunque actualmente esta información se suele subir a la “nube” para evitar problemas de envío y tamaño de archivos, lo cierto es que se sigue usando habitualmente la compresión.

En Internet hay multitud de códigos en VBA y otros lenguajes para extraer los archivos o carpetas en ZIP. Haciendo un muestreo de dichos códigos y tras volver a programar algunos métodos para hacerlos más eficientes, os dejo la siguiente macro:

Sub DESCOMPRIMIR_ZIP()
'Definimos variables
Dim objShell As Object
Dim iArchivo As Variant, Nombre_Carpeta As Variant
Dim Ruta As String, i As Long
Dim objScripting, objCarpeta
'Seleccionamos archivos zip
iArchivo = Application.GetOpenFilename(filefilter:="Archivos ZIP (*.zip), *.zip", MultiSelect:=True)
'Si no seleccionamos nada, salimos del proceso
If IsArray(iArchivo) = False Then Exit Sub
'Indicamos el directorio actual de nuestro archivo o donde queremos crear o guardar nuestros archivos
Ruta = Application.ActiveWorkbook.Path & "\"
'Nombramos la carpeta en la que vamos a descomprimir los ZIP
Nombre_Carpeta = Ruta & "ARCHIVOS EXTRAIDOS " & Replace(Date, "/", "_") & " " & Format(Now, "hh_mm_ss") & "\"
'Creamos la carpeta con el nombre anterior
Set objScripting = CreateObject("Scripting.FileSystemObject")
Set objCarpeta = objScripting.CreateFolder(Nombre_Carpeta)
'Procedemos a copiar los archivos y carpetas de los ZIP seleccionados a nuestra nueva carpeta
Set objShell = CreateObject("Shell.Application")
For i = LBound(iArchivo) To UBound(iArchivo)
objShell.Namespace(Nombre_Carpeta).CopyHere objShell.Namespace(iArchivo(i)).items
Next i
Set objScripting = Nothing
Set objCarpeta = Nothing
Set objShell = Nothing
End Sub

Cuando ejecutamos el código, se nos abrirá una ventana de diálogo para seleccionar los archivos ZIP. Para este ejemplo he comprimido la carpeta con los archivos de mi última entrada:

* Aunque la imagen parece un archivo .RAR no lo es, en WinRAR podemos comprimir también en ZIP. Solo que el icono no es de siempre, sino el de WinRAR, pero la extensión es .ZIP.

DESCOMPRIMIR ARCHIVOS .ZIP DESDE EXCEL CON VBA3

Cuando pulsamos en Abrir, la macro generará una capeta en el directorio que hemos especificado en el código, (en este caso en el mismo lugar en el que hayamos guardado el archivo Excel con la macro. La carpeta se nombrará con el nombre “ARCHIVOS EXTRAIDOS” y con la fecha y hora del momento, así no tendremos problemas por duplicidad en el nombre de las carpetas. Así:

DESCOMPRIMIR ARCHIVOS .ZIP DESDE EXCEL CON VBA1

Y dentro de esta carpeta, estará la información que tenemos en el ZIP:

DESCOMPRIMIR ARCHIVOS .ZIP DESDE EXCEL CON VBA2

Obviamente, podemos indicar cualquier otro destino para la creación de la carpeta, por ejemplo, si queremos que se cree en el escritorio, debemos indicarlo en la macro (en mi equipo sería así:

Ruta = "C:\Users\Segu\Desktop" & "\"

Por otra parte, también he implementado con otro método más eficiente que MKDir la manera de crear una carpeta:

Set objScripting = CreateObject("Scripting.FileSystemObject")
Set objCarpeta = objScripting.CreateFolder(Nombre_Carpeta)

Ojo, este código sirve únicamente para extensiones .ZIP no para .RAR (que espero programar y mostrar en breve).

Y esto ha sido todo, espero que os sea de utilidad para ahorra tiempo en vuestros procesos.

Descarga el archivo de ejemplo pulsando en: DESCOMPRIMIR ARCHIVOS .ZIP DESDE EXCEL CON VBA

 

SUMAR UN RANGO EN FILAS (EN HORIZONTAL) DEPENDIENDO DE UN VALOR

Hola a todos 🙂

Espero que todo os vaya bien!.

El post de hoy va a ser muy corto y será ampliación de un post anterior fruto de la consulta de un lector. En concreto el post es el siguiente: SUMAR UN RANGO DEPENDIENDO DE UN VALOR

En esa publicación lo que se expone es la forma de sumar un rango de números en función de un valor, o lo que es lo mismo, sumar utilizando un rango dinámico.

Lo que el lector solicitaba era poder hacer el mismo ejercicio pero estando el rango de la suma en una fila y no una columna, es decir, en horizontal. Pues bien, para solucionar esta duda, utilizaremos el siguiente ejemplo, donde debajo de cada mes se encuentra una cifra (que pueden ser datos de negocio, de facturación , etc):

SUMAR UN RANGO EN FILAS (EN HORIZONTAL) DEPENDIENDO DE UN VALOR

Y debemos introducir la siguiente fórmula para realizar la operación:

=SUMA(A2:INDIRECTO("F2C"&B4;0))

Para determinar la referencia al rango que se encuentra en la función INDIRECTO, debemos hacer uso del estilo de referencia F1C1 que nos permite indicar fila y columna. De modo que podemos vincular un valor a la columna y establecer la fila en el 2 (segunda fila). La fórmula traducida en el ejemplo es: =Suma(A2:K2)

Como podéis observar, la suma hasta el mes de Noviembre es de 894

Pero también podemos sumar un rango de varias filas, por ejemplo así:

SUMAR UN RANGO EN FILAS (EN HORIZONTAL) DEPENDIENDO DE UN VALOR2.jpg

Solo tenemos que indicar el rango a sumar en la fórmula indicando la fila 6 y la columna 11:

=SUMA(A2:INDIRECTO("F6C"&B8;0))

Y el resultado es de 7.214 🙂

Ya sé que es un post muy cortito, pero el hecho que me lo hayan planteado en una consulta, quiere decir que tiene utilidad.

Descarga el archivo de ejemplo pulsando en: SUMAR UN RANGO EN FILAS (EN HORIZONTAL) DEPENDIENDO DE UN VALOR

 

EXTRAER CUALQUIER PALABRA DE UNA CADENA DE TEXTO

Hola de nuevo a todos 🙂

Espero que hayáis tenido unas estupendas vacaciones 🙂 Yo ya las he finalizado y empiezo de nuevo con nuevas energías.

En el post de hoy vamos a introducirnos en el mundo de las fórmulas para mostrar cómo podemos obtener (extraer) cualquier palabra que nos propongamos en una cadena de texto y con una única fórmula.

Vamos a imaginar que tenemos los siguientes datos y que queremos extraer el número de experimento, los grados y las atmósferas:

EXTRAER CUALQUIER PALABRA DE UNA CADENA DE TEXTO

Esto se puede realizar con una macro, siempre que contemos con la misma estructura, de lo contrario, en programación puede suponer un desarrollo mayor.

Para poder comenzar la extracción solo vamos a necesitar una fórmula en la que combinaremos y anidaremos varias funciones. Para extraer la palabra que queremos, debemos conocer el número de ocupa en el texto, es decir: el número de experimento sería la sexta palabra, los grados la octava y las atmósferas la onceaba.

La única particularidad es que en la estructura de la fórmula, debemos indicar siempre un número menos del que tiene la palabra a extraer, por ejemplo, para extraer el número de experimento, que es la sexta palabra, debemos indicar en la fórmula el 5:

=EXTRAE(EXTRAE(EXTRAE(SUSTITUIR(A2;" ";"*";5);1;LARGO(A2));ENCONTRAR("*";SUSTITUIR(A2;" ";"*";5));LARGO(A2));2;ENCONTRAR(" ";EXTRAE(EXTRAE(SUSTITUIR(A2;" ";"*";5);1;LARGO(A2));ENCONTRAR("*";SUSTITUIR(A2;" ";"*";5));LARGO(A2)))-2)

Solo debemos indicarlo en la función SUSTITUIR, (que os marco en rojo).

Para extraer los grados, debemos indicar el 7 en la fórmula, dado que la palabra ocupa el octavo lugar:

=EXTRAE(EXTRAE(EXTRAE(SUSTITUIR(A2;" ";"*";7);1;LARGO(A2));ENCONTRAR("*";SUSTITUIR(A2;" ";"*";7));LARGO(A2));2;ENCONTRAR(" ";EXTRAE(EXTRAE(SUSTITUIR(A2;" ";"*";7);1;LARGO(A2));ENCONTRAR("*";SUSTITUIR(A2;" ";"*";7));LARGO(A2)))-2)

Para extraer las atmósferas, debemos indicar el 10 en la fórmula, dado que la palabra ocupa el onceavo lugar:

=EXTRAE(EXTRAE(EXTRAE(SUSTITUIR(A2;" ";"*";10);1;LARGO(A2));ENCONTRAR("*";SUSTITUIR(A2;" ";"*";10));LARGO(A2));2;ENCONTRAR(" ";EXTRAE(EXTRAE(SUSTITUIR(A2;" ";"*";10);1;LARGO(A2));ENCONTRAR("*";SUSTITUIR(A2;" ";"*";10));LARGO(A2)))-2)

El resultado, después de aplicar la fórmula en cada columna, es el siguiente:

EXTRAER CUALQUIER PALABRA DE UNA CADENA DE TEXTO1

Como habéis podido comprobar, hemos realizado un ejercicio muy habitual cuando trabajamos con cadenas de texto y sin tener que utilizar código. Además podemos trabajar aunque la estructura no sea igual en todos los casos, solo tenemos que indicar el número de la palabra que queremos extraer para conseguirlo.

Y esto ha sido todo por hoy, aún tengo bastante lío con las consultas pendientes y tengo que darle duro.

Como siempre, os dejo el archivo de ejemplo. Espero que os sea de utilidad 🙂

Descarga el archivo de ejemplo pulsando en: EXTRAER CUALQUIER PALABRA DE UNA CADENA DE TEXTO

 

INSERTAR CELDAS INTERCALADAS EN BLANCO EN EXCEL

Hola a todos 🙂

Hace pocos días que publiqué mi último post pero hoy aprovecho que tengo algo de tiempo para escribir uno nuevo.

Será un post muy breve dado que se trata de la modificación del código de un post anterior: INSERTAR FILAS INTERCALADAS EN BLANCO EN EXCEL

Y el motivo de la modificación del código es una consulta recibida en la que me preguntaban “buenísimo! y si quiero que lo haga a nivel celda en una sola columna? =)

Pues es relativamente sencillo, dado que en el código anterior insertábamos filas en blanco, en esta versión insertaremos celdas en blanco en la columna seleccionada.

Siguiendo con el ejemplo, tenemos la siguiente tabla:

INSERTAR FILAS INTERCALADAS EN BLANCO EN EXCEL

Y lo que vamos a hacer es intercalar una celda en blanco en las columnas de “Jueves” y “Sábado”. Para ello, vamos a utilizar

Sub Insertar_celdas()
'Definimos variables
Dim tTop, rFila, i, j As Double
'Buscamos el número de columna en el que estamos
nColum = ActiveCell.Column
'Buscamos la letra de la columna en la que estamos
lColum = Split(ActiveCell.Address, "$")(1)
'Determinamos el rango para definir la longitud del bucle for-next
Rango = lColum & ":" & lColum
'Indicamos el número de línea sobre el que comenzamos a añadir celdas en blanco
tTop = 3
'Indicamos el número de celdas en blanco a incluir
rFila = 1
fin = Application.CountA(ActiveSheet.Range(Rango))
For j = 2 To fin
'Si la primera celda (en este caso la 3) contiene un valor,
'entonces comenzamos a insertar celdas intercaladas
If Not IsEmpty(Cells(tTop, nColum)) Then
For i = 1 To rFila
Cells(tTop, nColum).Insert Shift:=xlDown
Next i
tTop = tTop + rFila + 1
End If
Next j
End Sub

Para acabar, en el ejemplo que os dejo, he utilizado, al igual que en la entrada anterior, otra macro para activar esta macro:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.OnKey "{ESCAPE}", "Insertar_celdas"
End Sub

La macro se activa pulsando la tecla “Escape. Pero podéis ejecutarla perfectamente vinculándola a un botón o ejecutándola directamente sobre el código.

Es decir, os posicionáis con el cursor encima de la columna “E” (Jueves) y pulsáis la tecla “Esc” y hacéis lo mismo con la columna “G” (Sábado).

El resultado es el siguiente:

INSERTAR CELDAS INTERCALADAS EN BLANCO EN EXCEL

Y ya está, como habéis podido observar, solo hemos cambiado la línea de código que insertaba filas vacías por esta otra:

Cells(tTop, nColum).Insert Shift:=xlDown

Y eso es todo, una pequeña modificación en la macro y obtenemos lo que necesitamos 🙂

Dado que estoy utilizando una macro que usa la combinación de teclas para activar la macro principal, a la hora de descargar el archivo os generará un error en tiempo de ejecución del método On Key. Este se puede corregir usando On Error Resume Next:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
Application.OnKey "{ESCAPE}", "Insertar_celdas"
On Error GoTo 0
End Sub

Pero no tiene mucho sentido dado que solo os ocurrirá cuando descarguéis el archivo, de todas formas os lo comento para vuestra información.

Una vez guardado, no se volverá a reproducir este error. O, como ya dije, podéis ejecutarlo vinculándolo a un botón o cualquier otro evento.

Descarga el archivo de ejemplo pulsando en: INSERTAR CELDAS INTERCALADAS EN BLANCO EN EXCEL