obsidian-dix/Agencia_Espacial_Mexicana/Excel-Macros_AEM/Prorrateo.md

Sub prorrateo()
' SUBRUTINA PARA PRORRATEAR EL PRESUPUESTO:
' FORMA DE EJECUTAR:
'   LOS VALORES A PRORATEAR DEBEN ESTAR EN VERTICAL, DEBES SELECCIONAR EL RÁNGO Y EJECUTAR EL SCRIPT
' ¿QUE HACE EL SCRIPT? (CUANDO SE HABLA DEL RANGO SE REFIERE A 12 CELDAS A LA DERECHA DE CADA UNO DE LOS VALORES SELECCIONADOS)
' 1.- SI EL RANGO ESTÁ VACIO ENTONCES PRORRATEA EN CADA MES DEL 1 AL 12 EL EQUIVALENTE A 8.33% DEL TOTAL, DEJA UN NÚMERO REDONDEADO A ENTERO Y EN EL MES DOCE SE HACE EL AJUSTE DE LOS CENTAVOS ACUMULADOS
' 2.- SI EL RANGO TIENE ENTEROS Y ESOS ENTEROS SUMAN 100 (CADA ENTERO SE CONVIERTE A DECIMAL) ENTONCES SE HACE EL PRORRATEO DE ACUERDO AL VALOR DE CADA CELDA Y EN LA ÚLTIMA CELDA SE HACE EL AJUSTE DE CENTAVOS
Dim rng As Range
Dim i As Integer
Dim o, e As Object
Dim val_base As Double
Dim last_val As Double
Dim prev_ttl As Double
Dim din_rng As Range
Dim rng1_11 As Range
Dim din_val As Double
Dim clls_with_vals As Integer
Dim count_cells_iter As Integer
Dim din_sub_ttl As Double

For Each o In Selection
    val_base = WorksheetFunction.Round(o.Value / 12, 0)
    last_val = o.Value - (val_base * 11)
    Set din_rng = Range(Cells(o.Row, o.Column + 1), Cells(o.Row, o.Column + 12))
    Set rng1_11 = Range(Cells(o.Row, o.Column + 1), Cells(o.Row, o.Column + 11))
    prev_ttl = WorksheetFunction.Sum(din_rng)
    
    If prev_ttl = 0 Then
        rng1_11.Value = val_base
        o.Offset(0, 12).Value = last_val
    
    ElseIf prev_ttl < 100 Then
        din_rng.Interior.Color = vbRed
    
    ' en caso de que el usuario haya asiganado porcentajes (el valor debe estar en entero, el script lo convierte en decimal)
    ElseIf prev_ttl = 100 Then
        ' hacer una sumatoria hasta llegar al 100
        clls_with_vals = WorksheetFunction.CountA(din_rng)
        count_cells_iter = 0
        Debug.Print clls_with_vals
        din_val = 0
        For Each e In din_rng
            din_val = din_val + e.Value
            If e.Value = "" Then
                e.Value = 0
            Else
                ' en caso de que sea solo una celda, esa selda es 100 seguramente
                If clls_with_vals = 1 Then
                    e.Value = WorksheetFunction.Round((e.Value / 100) * o.Value, 0)
                
                ' -> lo ando resolviendo
                ElseIf clls_with_vals > 1 Then
                    If count_cells_iter + 1 < clls_with_vals Then
                        e.Value = WorksheetFunction.Round((e.Value / 100) * o.Value, 0)
                        count_cells_iter = count_cells_iter + 1
                    Else: count_cells_iter = clls_with_vals
                        din_sub_ttl = o.Value - WorksheetFunction.Sum(Range(Cells(o.Row, o.Column + 1), Cells(o.Row, e.Column - 1)))
                        e.Value = din_sub_ttl
                    End If
                End If
                'e.Value = WorksheetFunction.Round((e.Value / 100) * o.Value, 0)
            End If
        Next e
        din_val = 0
    End If
Next o
MsgBox "FIN DEL CÁLCUO", vbOKOnly, "PRORRATEO"
End Sub