VBA: Una macro para autocompletar gradualmente intervalos vacíos.

Retomando la entrada anterior del blog (ver, en la que se explicaba cuál era la regla aritmética que emplea Excel para calcular el factor de crecimiento/disminución al emplear la herramienta Series, veremos como realizar esta operación para un número indeterminado de rangos...
Esta explicación da respuesta a la cuestión planteada por un lector:

Como podría hacer si mis valores no son correlativos, subieran y/o bajaran casi de forma aleatoria y el espacio entre ellos también es variable y tuviera que interpolar cogiendo el último valor (orden descendente) y el siguiente. Ejemplo  1 97 2 97 3  4  5 96 6 96 7  8  9 98 10 98 11  12  13  14 98 15 98 El tipo de interpolación es gradual, es decir, debería calcular la diferencia y dividir por el número de celdas, de tal modo que en el ejmplo anterior, de 97 pase a 96.6777, 96.333 y finalmente 96, que es el valor que ya disponemos. Cuando lo hago manual lo hace automáticamente si cojo la ultima celda con valores y la primera de la siguiente tanda...pero claro estamos hablando de miles de datos para cada archivo.

Veamos en la siguiente imagen el planteamiento:

Podemos ver en el rango C3:C25 una disposición de valores y celdas vacías a completar con valores secuenciales determinados por el valor de la última y siguiente celda con dato.
Al lado, en el rango E3:E25 vemos el resultado de ir ejecutando la herramienta Series, manualmente, rango a rango (rangos C5:C7, C7:C9, C11:C14, C15:C20 y C21:C25.

Así añadiremos nuestro código en un módulo de nuestro proyecto VBA:

Sub CompletaSerieGradual()
Dim celda As Object
Dim paso As Double, Inicial As Double, Final As Double
Dim blancos As Long
'generamos una colección
Set unicos = New Collection
Set Rng = Range("C3:C25")

For Each celda In Rng
    'determinamos las celdas en las que hay una ruptura
    'es decir, cuando hay un salto
    If (celda.Value <> "" And celda.Value <> celda.Offset(-1, 0).Value) _
        Or (celda.Value <> "" And celda.Value <> celda.Offset(1, 0).Value) Then
        'cuando encuentre un item repetido, daría un error
        'que salvamos con la instrucción On Error Resume Next
        On Error Resume Next
        'por tanto, nuestra coleccion solo agrega elementos no repetidos
        'y en concreto en qué celda se encuentra el nuevo elemento
        unicos.Add celda.Address, CStr(celda.Address)
        On Error GoTo 0
    End If
Next celda

'Recorremos las celdas que determinan los rangos a analizar
For j = 1 To unicos.Count - 1
    'damos valor de cálculo a nuestras variables
    blancos = Application.WorksheetFunction.CountBlank(Range(unicos(j), Range(unicos(j + 1))))
    Final = Range(unicos(j + 1)).Value
    Inicial = Range(unicos(j)).Value
    'trabajaremos sólo cuando el rango definido tenga celdas vacías intermedias
    If blancos > 0 Then
        paso = (Final - Inicial) / (blancos + 1)
        'aplicamos la herramienta Series con un Step personalizado
        Range(unicos(j), Range(unicos(j + 1))).DataSeries Rowcol:=xlColumns, _
            Type:=xlLinear, Date:=xlDay, Step:=paso, Trend:=False
    End If
Next j

End Sub

Tras ejecutar nuestra macro podemos ver el resultado...