```vba 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 ```