¿Cómo insertar un rango de celdas hacia abajo en excel con una Macro solo si se cumple una condición?
Tengo dos columnas, A y B en las cuales tengo al rededor de 3000 fechas, en la columna A las fechas están completas, sin embargo en la columna B están incompletas, entonces quisiera que excel hiciera lo siguiente: si la fecha de la columna B no coincide con la de la columna A, entonces que inserte un rango horizontal de celdas hacia abajo que iría de B a H, ejemplo:
A B C D E F G H
1 01/01/2000 01/01/2000 X X X X X X
2 02/01/2000 02/01/2000 X X X X X X
3 03/01/2000 03/01/2000 X X X X X X
4 04/01/2000 05/01/2000 X X X X X X
Como en la celda B4 no coinciden las fechas con las de A4, entonces quisiera que excel insertara un rango de celdas de B4:H4, quedando así:
A B C D E F G H
1 01/01/2000 01/01/2000 X X X X X X
2 02/01/2000 02/01/2000 X X X X X X
3 03/01/2000 03/01/2000 X X X X X X
4 04/01/2000
5 05/01/2000 05/01/2000 X X X X X X
Y así sucesivamente en toda la columna para que las fechas de ambas columnas coincidan.
Este proceso lo repetiré en al menos 50 columnas más.
Si alguien me pudiera ayudar se lo agradeceré infinitamente.
1 Respuesta
H o l a : Te anexo la macro. Antes de ejecutar la macro, crea una hoja llamada "temp", la macro la utiliza para realizar operaciones.
Cambia en la macro en esta parte por los datos de tu hoja.
Set h1 = Sheets("Hoja1") 'hoja con fechas
Set h2 = Sheets("temp") 'hoja temporal
col1 = "A" 'columna fechas completas
col2 = "B" 'columna fechas incompletas
col3 = "H" 'columna finalSegún tu ejemplo se tiene que comparar la columna A y la B.
Sub CoincidirFechas()
'Por.Dante Amor
Application.ScreenUpdating = False
Set h1 = Sheets("Hoja1") 'hoja con fechas
Set h2 = Sheets("temp") 'hoja temporal
col1 = "A" 'columna fechas completas
col2 = "B" 'columna fechas incompletas
col3 = "H" 'columna final
'
h2.Cells.Clear
u = h1.Range("B" & Rows.Count).End(xlUp).Row
h1.Columns(col1).Copy h2.Range("A1")
h1.Range(h1.Cells(1, col2), h1.Cells(u, col3)).Copy h2.Range("B1")
coln = Columns(col3).Column - Columns(col2).Column + 2
h1.Range(h1.Cells(1, col2), h1.Cells(u, col3)).ClearContents
'
j = u + 2
For i = 1 To u
Set b = h1.Columns(col1).Find(h2.Cells(i, col2), lookat:=xlWhole)
If Not b Is Nothing Then
h2.Range(h2.Cells(i, "B"), h2.Cells(i, coln)).Copy h1.Cells(b.Row, col2)
Else
h2.Range(h2.Cells(i, "B"), h2.Cells(i, coln)).Copy h1.Cells(j, col2)
j = j + 1
End If
Next
Application.ScreenUpdating = True
MsgBox "Fin"
End SubEntonces, si por ejemplo tienes que comparar la columna I contra la J y los datos terminan en la P, tendrías que modificar la macro así:
col1 = "I" 'columna fechas completas col2 = "J" 'columna fechas incompletas col3 = "P" 'columna final
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
