Apoyo para encontrar el error de la macro

[pedrosilv]

Buena noche a todos:

Tengo una macro que me compartió un amigo desde hace varios meses, pero no tuve la oportunidad de probar, sin embargo, ahora que lo necesité, traté de utilizarlo pero me arroja un error de #¡VALOR!

Esta macro en teoría calcula el área de un polígono usando angulos azimutales y distancias. Para ello selecciono de primero el rango de las distancias, luego el rango que contiene los ángulos azimutales, pero como resultado obtengo el mensaje anterior.

Adjunto el archivo de ejemplo, para ver si alguien pueda apoyarme.

 

Saludos.

Ejemplo.xlsm

[Abraham Valencia]

Hola

Para poder ayudarte realmente, y no darle a nadie el trabajo de buscar, sería mejor que compartas la fórmula (no hablo de Excel) y/o forma de hacer eso para así poder comparar con lo que se ha hecho en VBA.

[Antoni]

Te dejo la UDF tal como yo la he entendido, pero ya te aviso, que el resultado no es el que tu propones.

Se podría mejorar bastante si se conociera la fórmula a aplicar, tal como indica Abraham.

Function AreaPoligono(DIS As Range, ANG As Range) As Double
    Dim angulosRad() As Double
    Dim lados() As Double
    Dim p As Double
    Dim a As Double
    Dim b As Double
    Dim c As Double
    Dim angulo As Double
    
    ' convertir los angulos a radianes
    ReDim angulosRad(ANG.Count)
    For Each celda In ANG
       angulosRad(i) = celda * Application.Pi / 180
       i = i + 1
    Next
    
    ' calcular los lados del poligono
    i = 0
    ReDim lados(DIS.Count)
    For Each celda In DIS
       lados(i) = celda
       i = i + 1
    Next
   
    ' calcular el area del poligono utilizando la ley de cosenos
    p = 1
    For i = 0 To UBound(lados)
        a = lados(i)
        b = lados(p)
        c = Sqr(a ^ 2 + b ^ 2 - 2 * a * b * Cos(angulosRad(i) - angulosRad(p)))
        angulo = WorksheetFunction.Acos((b ^ 2 + c ^ 2 - a ^ 2) / (2 * b * c))
        AreaPoligono = AreaPoligono + 0.5 * b * c * Sin(angulo)
        p = i
    Next i
End Function

[Nancy]

Function AreaPoligono(DIS As Range, ANG As Range) As Double
    Dim i As Integer
    Dim celda As Range
    Dim angulosRad() As Double
    Dim lados() As Double
    Dim p As Integer: p = 0
    Dim a As Double
    Dim b As Double
    Dim c As Double
    Dim angulo As Double
    
    ' convertir los angulos a radianes
    ReDim angulosRad(ANG.Count)
    For Each celda In ANG
       angulosRad(i) = celda * Application.Pi / 180
       i = i + 1
    Next
    
    ' calcular los lados del poligono
    i = 0
    ReDim lados(DIS.Count)
    For Each celda In DIS
       lados(i) = celda
       i = i + 1
    Next
   
    ' calcular el area del poligono utilizando la ley de cosenos
    p = 1
    For i = 0 To UBound(lados)
        a = lados(i)
        b = lados(p)
        c = Sqr(a ^ 2 + b ^ 2 - 2 * a * b * Cos(angulosRad(i) - angulosRad(p)))
        angulo = WorksheetFunction.Acos((b ^ 2 + c ^ 2 - a ^ 2) / (2 * b * c))
        AreaPoligono = AreaPoligono + 0.5 * b * c * Sin(angulo)
        p = i
    Next i
End Function

  seria asi y queda mejor

[pedrosilv]

Muchas gracias maestro Abraham Valencia, Antoni y Nancy.

Lamento el inconveniente al subir el archivo sin el proceso que lleva el cálculo del área, mea culpa.

Probé la última macro que me envió Nancy y Antoni, y tienen mucha razón ya que la macro no me calcula adecuadamente el área.

Adjunto el archivo donde detallo el proceso que se debe seguir para calcular el área manualmente, y que es el procedimiento que utilizan los softwares de Sistemas de Información Geográficos para estimar el área.

De nuevo, muchas gracias por su tiempo y apoyo.

Saludos

Ejemplo.xlsm

[pedrosilv]

Por cierto, la macro que subí utiliza otro procedimiento al indicado, estuve viendo esta macro, pero al usarlo me arroja un error de "#¡VALOR!

Function CalcularAreaPoligono(distancias As Range, grados As Range, minutos As Range, segundos As Range) As Double
    
    Dim numVertices As Integer
    Dim coordenadas() As Variant
    Dim i As Integer
    Dim anguloRad As Double
    
    ' Verificar que los rangos tengan la misma cantidad de elementos
    If distancias.Count <> grados.Count Or grados.Count <> minutos.Count Or minutos.Count <> segundos.Count Then
        CalcularAreaPoligono = CVErr(xlErrValue)
        Exit Function
    End If
    
    ' Obtener la cantidad de vértices
    numVertices = distancias.Count
    
    ' Redimensionar el array de coordenadas
    ReDim coordenadas(numVertices, 2)
    
    ' Definir la coordenada base
    coordenadas(1, 1) = 1000
    coordenadas(1, 2) = 2000
    
    ' Calcular las coordenadas de los demás vértices
    For i = 1 To numVertices - 1
        anguloRad = WorksheetFunction.Radians(grados.Cells(i).Value + (minutos.Cells(i).Value / 60) + (segundos.Cells(i).Value / 3600))
        coordenadas(i + 1, 1) = coordenadas(i, 1) + (distancias.Cells(i).Value * WorksheetFunction.Sin(anguloRad))
        coordenadas(i + 1, 2) = coordenadas(i, 2) + (distancias.Cells(i).Value * WorksheetFunction.Cos(anguloRad))
    Next i
    
    ' Calcular el área del polígono
    Dim area As Double
    area = 0
    
    For i = 1 To numVertices
        If i = numVertices Then
            area = area + ((coordenadas(i, 1) * coordenadas(1, 2)) - (coordenadas(1, 1) * coordenadas(i, 2)))
        Else
            area = area + ((coordenadas(i, 1) * coordenadas(i + 1, 2)) - (coordenadas(i + 1, 1) * coordenadas(i, 2)))
        End If
    Next i
    
    area = area / 2
    
    ' Devolver el resultado
    CalcularAreaPoligono = area

End Function

 

[Antoni]

Revisa el adjunto.

Ya comentarás s quieres partir de grados, minutos y segundos  o ya te va bien partir del AZIMUT.

Function AreaPoligono(DISTANCIAS As Range, AZIMUT As Range) As Double
'Variables
Dim i As Long
Dim Radianes() As Double, Lados() As Double
Dim Seno As Double, xSeno As Double, tSeno As Double, aSeno As Double
Dim Coseno As Double, xCoseno As Double, tCoseno As Double, aCoseno As Double
Dim X As Double, Y As Double

    'Convertimod los ángulos a radianes
    ReDim Radianes(AZIMUT.Count)
    For Each celda In AZIMUT
       Radianes(i) = celda * Application.Pi / 180
       i = i + 1
    Next
    
    'Guardamos los lados del poligono
    i = 0
    ReDim Lados(DISTANCIAS.Count)
    For Each celda In DISTANCIAS
       Lados(i) = celda
       i = i + 1
    Next
   
    'Calculamos el area del polígono utilizando la ley de cosenos
    For i = 0 To UBound(Lados) - 1
    
        'Calculamos coordenadas
        xSeno = Sin(Radianes(i)) * Lados(i) + Seno
        xCoseno = Cos(Radianes(i)) * (Lados(i)) + Coseno
        X = xCoseno * aCoseno
        Y = xSeno * aSeno
        
        'Totalizamos
        tSeno = tSeno + X
        tCoseno = tCoseno + Y
        
        'Guardamos anteriores
        Seno = xSeno
        Coseno = xCoseno
        aSeno = Coseno
        aCoseno = Seno

    Next i
    AreaPoligono = Abs(tSeno - tCoseno) / 2
End Function

 

Ejemplo (3).xlsm

[pedrosilv]

Muchísimas gracias mi estimado Antoni.

Hay posibilidades que me apoyes con la obtención del área a partir de Grados, Minutos y Segundos?

Desde ya, muchas gracias.

Saludos

[Antoni]

Ahí va.

Área polígono.xlsm

[pedrosilv]

Mil gracias Antoni.

Me has ayudado un montón.

Que tengas buen día.