Como mejorar macro que rrellena celdas vacias con inputbox de columnas adyacentes

Que hace lo siguiente:

Busca las celdas vacias en una columna y lo rrellena con los valores que ingreso, sin embargo debo repetir el codigo par rrellanar la columna adyacente, en este caso empieza en la columna B para pasar a la columna C, los datos en cada columna son diferentes, en la columna B va el sector, en la columna C va la provincia, ustedes creen que puedo mejorar esta macro, por favor agradeceré si me ayudan.

Hbia pensando que se podia hacer con un ciclo for next, pero hast ahí nada mas llegué:

Sub RellenarCeldas()
Dim Celdas As Range
Dim Valor As Variant
Dim x As Long
Dim y As Double 'para el ciclo for
With Hoja2
 x = .Range("A" & .Rows.Count).End(xlUp).Row
 '=====Primer dato
 'For y = 1 To 2 '============Con este for Puede ser
 .Range("B2:B" & x).Select
 'el siguiente rango debe ser  la columna C
Valor = InputBox("Sector", "Datos de Ubicacion")
Selection.SpecialCells(xlCellTypeBlanks).Select
For Each celda In Selection
    celda.Value = Valor
Next celda
'Next y'============ con este ciclo?
'segundo dato'
'=======
 .Range("C2:C" & x).Select
Valor = InputBox("Distrito", "Datos de Ubicacion")
Selection.SpecialCells(xlCellTypeBlanks).Select
For Each celda In Selection
    celda.Value = Valor
Next celda
End With
End Sub

Lo quiero hacerlo mas ismple por que debo rrellenar  20 columnas del mismo modo y es  muy largo el código.

Agradecido por su ayuda.

2 Respuestas

Respuesta
1

Se me ocurren 2 opciones: que en el inputbox solo solicites el dato por número de columna (o incluso con un agregado podrías indicar la letra de la col) o que tengas en algún sector de tu hoja o libro la lista ya cargada.

Por ahora te presento la primer opción. El bucle llega hasta la col 5, es decir E. Ajustá este nro al total de col que necesites.

Sub RellenarCeldas()
'x Elsamatilde
Dim Celda As Range
Dim Valor As Variant
Dim x As Long
Dim y As Byte 'para el ciclo for
With Hoja2
'col A establece el fin de rango
 x = .Range("A" & .Rows.Count).End(xlUp).Row
 For y = 2 To 5    'aquí va el total de columnas, a partir de B
 .Range(Cells(2, y), Cells(x, y)).Select
 'el siguiente rango debe ser  la columna C
Valor = InputBox("Ingrese dato para la columna " & y, "Datos de Ubicacion")
Selection.SpecialCells(xlCellTypeBlanks).Select
For Each Celda In Selection
    Celda.Value = Valor
Next Celda
'paso a la col siguiente
Next y
End With
End Sub

Si esta opción te alcanza, no olvides valorar la respuesta.

Respuesta
1

·

Se puede mejorar la macro de Elsa. Se hacen varias operaciones separadas que se pueden juntar todas en una y el tiempo será mucho menor, si las columnas son grandes se notará la mejora.

También se produce un error cuando en una columna no queda ninguna celda en blanco y se interrumpe el programa. Simplemente le diuremos que ejecute la siguiente instrucción en lugar de pararse.

Esto se hace con la instrucción

On Error Resume Next

Pero tan importante como poner esa instrucción cuando es necesario, es quitarla cuando ya no hace falta ya que impedirá que aparezcan los errores de otros lugares y el programa podrá hacer barbaridades sin que lo sepamos. Luego justo después de terminar de poner los valores hay que poner

On Error Goto 0

para desactivarla y volver al sistema de información de errores habitual.

Sub RellenarCeldas()
'x Elsamatilde & ValeroASM
Dim Valor As Variant
Dim x As Long
Dim y As Byte 'para el ciclo for
With Hoja2
'col A establece el fin de rango
 x = .Range("A" & .Rows.Count).End(xlUp).Row
 On Error Resume Next
 For y = 2 To 5    'aquí va el total de columnas, a partir de B
   Valor = InputBox("Ingrese dato para la columna " & y, "Datos de Ubicacion")
   .Range(Cells(2, y), Cells(x, y)).SpecialCells(xlCellTypeBlanks) = Valor
 Next y
End With
'No se puede dejar el "on error resume next" activo ya que
'no nos avisaría de errores en otros lugares
On Error GoTo 0
'Aquí pueden venir más instrucciones
'...
'...
End Sub

Y eso es todo.

¡Gracias! Valero,

Ustedes los expertos son muy generosos.

Con los detalles esta macro funciona de maravillas.

No me queda más que desearle un bue y extraordinario día.

Saludos.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas