Calcular Inversa de la distancia para un punto fijo VBA Excel

[SchroederAaron]

Hola estoy haciendo un programa en VBA en Excel y me falta solo un elemento para incluir en la función.
El programa debe de sumar la distancia entre dos puntos y sumarla si cumple ciertas condiciones, esto parte de una lista de puntos, donde si es el mismo punto la distancia es cero, asi sucesivamente hasta completar todos los puntos, ahorita tengo un código que empece pero me marca un error, creo que no estoy tan perdido, envío el codigo:

Código: [Seleccionar]

'Función para Calcular Inversa de la Distancia al Cuadrado (1/D)^n un punto cumpliendo condiciones
Function SUMWS(Po, Pfs As Range, x As Integer, y As Integer, n As Integer, Fecha As Date) As Double 'Pfs es la variable que recibe el rango de puntos a evaluar
'Esta función SUMA las W si cumple ciertas Condiciones (Fecha, Valor<>"", Po<>Pfs)
    Dim DIST, W, Xo, Yo, Xf, Yf As Double
    Dim COND As Double 'Integer
    If Pfs = Po Then
        CW = Empty
        Else
        Z = Pfs.EntireRow.Count
        SUMWS = Null
        For Each Pf In Pfs
' Condiciones de Fechas Iguales, Valor Diferente de Vacío y Diferentes Puntos (Fecha, Valor<>"", Po<>Pfs)
            COND = Application.WorksheetFunction.CountIfs(Worksheets("Registro").Range("B:B"), _
            Fecha, Worksheets("Registro").Range("A:A"), Pf, Worksheets("Registro").Range("C:C"), ">0")
           
            Xo = Application.WorksheetFunction.VLOOKUP(Po, Worksheets("Est Aled").Range("B:K"), x, False) 'Busca Xo
            Xf = Application.WorksheetFunction.VLOOKUP(Pf, Worksheets("Est Aled").Range("B:K"), x, False) 'Busca Xf
            DistX = (Xo - Xf) ^ 2 'Calcula Binomio Cuadrado de X
           
            Yo = Application.WorksheetFunction.VLOOKUP(Po, Worksheets("Est Aled").Range("B:K"), y, False) 'Busca Yo
            Yf = Application.WorksheetFunction.VLOOKUP(Pf, Worksheets("Est Aled").Range("B:K"), y, False) 'Busca Yf
            DistY = (Yo - Yf) ^ 2 'Calcula Binomio Cuadrado de Y

            DIST = (DistX + DistY) ^ (1 / 2) 'Calcula la Distancia entre puntos
            W = 1 / DIST ^ n 'Calcula la función inversa de la distancia elevado a la n (1/D)^n
' Sumatoria de la función inversa de la distancia elevado a la n (1/D)^n
            CW = COND * W 'Si cumple las condiciones COND = 1, si no COND = 0 y se multiplica por la función W
            SUMCW = CW + Pf
        Next Pf
            SUMWS = CW
    End If
End Function

Gracias y espero su ayuda, tambien envio erchivo en Excel

[Mastermind]

El problema podría estar aquí: W = 1 / DIST ^ n, al aplicar esta fórmula el valor de DIST puede ser cero, si fuera cero se produce una indefinición o valor no calculable. Ver: http://es.wikipedia.org/wiki/Divisi%C3%B3n_por_cero

Si este fuera el problema, tendrías que detectar con un if si el valor de DIST es cero y en ese caso no hacer esta operación.

[SchroederAaron]

Estoy de acuerdo, todo número dividido entre cero es indeterminado o un error, si te fijas en el código en la sexta línea esta un IF cuando Po y Pfs (el rango de puntos) son iguales.
Lo que estoy intentando hacer es rellenar espacios de series históricas de precipitaciones con estaciones climatologías cercanas, en el método esta la formula:

Px=ΣPiWi/ΣWi

donde
Pi=son las precipitaciones de las otras estaciones
Wi=es la inversa de la distancia al cuadrado
ΣWi=es la inversa de la distancia al cuadrado de todas las estaciones

Las restricciones que para las estaciones aledañas son que deben tener la misma fecha y tener dato para poder hacer el calculo

Mando un archivo de Excel que tiene los códigos que hasta ahorita llevo.

Gracias, por todo y espero que me sigas ayudando

[Mastermind]

¿Cuál es el error que te aparece? ¿Te señala la línea en que está?

[SchroederAaron]

En el código no aparece nada solo aparece el error en la hoja de Excel #Valor! lo que me imagino es que en el código no están bien declaradas las variables.
Para la Inversa de la distancia (W) tengo un código aparte donde hace bien el calculo lo único que necesito es que haga el calculo para todos los puntos del rango, mando el código de W, DISTANCIA y PRECIP (P)

Código: [Seleccionar]

'Función para calcular Distancia entre puntos
Function DIST(Po, Pf, x As Integer, y As Integer) As Double
    Dim Xo, Yo, Xf, Yf As Double
    Xo = Application.WorksheetFunction.VLOOKUP(Po, Worksheets("Est Aled").Range("C:L"), x, False) 'Busca Xo
    Yo = Application.WorksheetFunction.VLOOKUP(Po, Worksheets("Est Aled").Range("C:L"), y, False) 'Busca Yo
    Xf = Application.WorksheetFunction.VLOOKUP(Pf, Worksheets("Est Aled").Range("C:L"), x, False) 'Busca Xf
    Yf = Application.WorksheetFunction.VLOOKUP(Pf, Worksheets("Est Aled").Range("C:L"), y, False) 'Busca Yf
    If Po = Pf Then 'Nunca calcula la Distancia para el mismo punto
        DIST = Empty
    Else: DistX = (Xo - Xf) ^ 2 'Calcula Binomio Cuadrado de X
        DistY = (Yo - Yf) ^ 2 'Calcula Binomio Cuadrado de Y
        DIST = (DistX + DistY) ^ (1 / 2) 'Calcula la distancia entre puntos
    End If
End Function


Código: [Seleccionar]

'Función para Calcular Inversa de la Distancia al Cuadrado (1/D)^n entre puntos
Function W(Po, Pf, x As Integer, y As Integer, n As Integer) As Double
    Dim DIST, Xo, Yo, Xf, Yf As Double
    If Po = Pf Then
        W = Empty
        Else: Xo = Application.WorksheetFunction.VLOOKUP(Po, Worksheets("Est Aled").Range("C:L"), x, False) 'Busca Xo
            Yo = Application.WorksheetFunction.VLOOKUP(Po, Worksheets("Est Aled").Range("C:L"), y, False) 'Busca Yo
            Xf = Application.WorksheetFunction.VLOOKUP(Pf, Worksheets("Est Aled").Range("C:L"), x, False) 'Busca Xf
            Yf = Application.WorksheetFunction.VLOOKUP(Pf, Worksheets("Est Aled").Range("C:L"), y, False) 'Busca Yf
            DistX = (Xo - Xf) ^ 2 'Calcula Binomio Cuadrado de X
            DistY = (Yo - Yf) ^ 2 'Calcula Binomio Cuadrado de Y
            DIST = (DistX + DistY) ^ (1 / 2) 'Calcula la Distancia entre puntos
            W = 1 / DIST ^ n 'Calcula la función Inversa de la Distancia elevado a la n (1/D)^n
    End If
End Function


Código: [Seleccionar]

'Función de Precipitación
Function PRECIP(Po, Pfs, Fecha As Date) As Double
    If Po = Pfs Then
        PRECIP = Empty
        Else: PRECIP = Application.WorksheetFunction.SUMIFS(Worksheets("Registro").Range("C:C"), Worksheets("Registro").Range("B:B"), Fecha, Worksheets("Registro").Range("A:A"), Pfs, Worksheets("Registro").Range("C:C"), ">0")
    End If
End Function

Si te fijas, este código es para dos puntos uno por vez, tengo ΣPiWi listo para cada uno de los puntos solo me falta el ΣW para completar la ecuación lo que necesito es que haga todos los cálculos en una sola celda.

[Mastermind]

tengo ΣPiWi listo para cada uno de los puntos solo me falta el ΣW

Si tienes ΣPiWi por qué no guardas Wi en un array y luego haces la suma del array con un recorrido con un bucle, de esa manera ya tendrías ΣW

[SchroederAaron]

y como se hace eso? 

Si te fijas no soy programador, y los códigos que tengo son más bien las formulas ya establecidas en Excel como SUMIF, VLOOKUP, COUNTIFS y esas cosas.

En un principio pensé en la estructura de SUMIFS "SUMAR.SI.CONJUNTO" pero además de sumar, era sumar la distancia o algo así. gracias por tu tiempo y tus consejos.

[Mastermind]

Pensé que eras programador. Estoy intentando hacer los cálculos a mano para comprender lo que debería obtenerse. En las columnas A y B tenemos las coordenadas de las estaciones. En la casilla M3 tenemos la distancia entre las estaciones 16004 y 16016 que es Di = 9250,66.

Calculamos Wi = 1 / Di^2 = 0,00000011685

¿Ahora cómo se calcula Pi?

 

[SchroederAaron]

En el archivo que adjunte (Prueba.xlsm) están los datos y el proceso paso a paso, lo que intento es que todo el proceso que de en una sola celda.

El planteamiento del problema es el siguiente para una estación cualquiera (16004) falta un dato en 1964 (en este casi es precipitación, pero puede ser cualquier variable), existen diferentes métodos para rellenar estos espacios uno de ellos es el USNWS, donde:

Px=PiWi/ΣW

Pi= Precipitación
Wi=Inversa de la distancia al cuadrado
ΣW= a la suma de todas las W

Para esto las estaciones deben cumplir ciertas condiciones, que corresponda en fecha del dato faltante de la estación y que tenga valor.

En el Archivo hay 10 estaciones y no todas sirven para hacer el calculo, también hay un método para la estación más cerca pero esta condición es la misma que la anterior, que tenga la misma fecha y que tenga valor diferente de vacío, no cero Vacío, por que en este caso Vacío no es lo mismo que cero.

Gracias por tu ayuda, te has tomado tu tiempo para esto.

Mando de nuevo archivo adjunto.

[Mastermind]

Entonces entiendo que los valores de Pi son los que tenemos en la columna F con el encabezado "Valor", ahí por ejemplo nos dice que para la estación 16004 y el año 1964 no existen datos, pero por contra para la estación 16004 el año 1965 el dato de precipitación es 805,50.

Antes pusiste que Px=ΣPiWi/ΣWi y ahora has puesto que Px=PiWi/ΣW, supongo que lo correcto es lo primero...

Para calcular Pi para la estación 16004 y año 1964 tomaríamos como datos:

Estación 16027 con Pi para 1964 vale 721,80; Wi valdría 0,000000003506

Estación 16096 con Pi para 1964 vale 740,40;  Wi valdría 0,000000003838

Estación 16105 con Pi para 1964 vale 719,00; wi valdría 0,000000093437

Estación 16114 con Pi para 1964 vale 1.327,90; wi valdría 0,000000006564

El valor de ΣWi sería ΣWi = 0,000000107345000



Descartaríamos:

Estación 16016 porque no tiene datos para 1964

Estación 16028 porque no tiene datos para 1964

Estación 16091 porque no tiene datos para 1964

Estación 16116 porque no tiene datos para 1964



Si calculamos ΣPiWi tendríamos:

Pi            Wi                                 Producto
721,8      0,000000003506000      0,000002530630800
740,4      0,000000003838000      0,000002530630800
719         0,000000093437000      0,000002530630800
1327,9      0,000000006564000      0,000002530630800
      

   Sumatorio ΣPiWi =   0,000010122523200



Calculamos ahora Px=ΣPiWi/ΣWi = 0,000010122523200 / 0,000000107345000 = 94,29897247


Pero este resultado no me cuadra, es demasiado bajo y si lo comparo con USNWS que aparece en la casilla W15 del archivo excel allí dice 757,09 y no sé dónde está el fallo

[SchroederAaron]

Es cierto, si te fijas en el rango (M15:V15) la inversa de la distancia esta multiplicada por 1,000,000; esto es por que las distancias están en metros y parece que se tiene que hacer una conversón de unidades de m a km.
En el rango (AA15:AJ15) también pasa algo similar

[Mastermind]

Lo he vuelto a intentar pero no soy capaz de reproducir el cálculo. Si multiplico por 1000000

Estación      Pi            Wi                                    Wi*1000000                                 Pi*(Wi*1000000)
16027   721,8   0,000000003505841397077420   0,000002530516320410480000   0,001826526680072290000000
16096   740,4   0,000000003837630494020430   0,000002530516320410480000   0,001826526680072290000000
16105   719   0,000000093437044599655500   0,000002530516320410480000   0,001826526680072290000000
16114   1327,9   0,000000006563761395688930   0,000002530516320410480000   0,001826526680072290000000
            
            
            
      0,000000107344277886442000      0,007306106720289140000000
            
            
            68062,37709

Obtengo 68062 en vez de 757,09

Creo que sin un manual no sería capaz de deshacer los cálculos, seguramente es sencillo si se conoce pero para mí no simplemente viendo el archivo excel.

[SchroederAaron]

Hola oye una pregunta en los cálculos que haz hecho cuando llegas a el resultado de 0,000000107344277886442000 tienes un código que lo hace en una sola celda?
Es que con eso creo que ya queda lo que necesito y ya quedaría.

Con el resultado que te da de 68062,377709 no se por que sale eso, en el archivo, en la celda M15 esta la formula =PRODUCTO(COND($K15,M$1,$L15),W($K15,M$1,2,3,2),1000000) y en la celda AA15 esta la formula =SI.ERROR(PRODUCTO(PRECIP($K15,M$1,$L15),COND($K15,M$1,$L15),W($K15,M$1,2,3,2),SUMA($M15:$V15)^-1),0), lo que esta en rojo es la suma de todos los punto y divide a cada una de las celdas de AA15 hasta AJ15 y eso a su vez se suma

Espero que esto ya quede, gracias por tu tiempo.