76 lines
3.0 KiB
Markdown
76 lines
3.0 KiB
Markdown
|
|
|
|
|
|
```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
|
|
```
|
|
|
|
|