• Inicio
  • Programas
  • Excel
  • Generar números aleatorios que sumen una cantidad objetivo con o sin decimales, excel, vba, macros

Generar números aleatorios que sumen una cantidad objetivo con o sin decimales, excel, vba, macros

Estas buscando ¿Cómo generar cantidades aleatorias que sumen un número objetivo?

A pesar de las confusas fórmulas y muchos cálculos inclusive haciendo más pesada la hoja de cálculo existe una mejor solución a los problemas relacionados con este caso.

En esta oportunidad comparto con ustedes este pequeño generador de números aleatorios que suman una cifra concreta o al 100% con la posibilidad de utilizar decimales y controlando la variación de los números generados. Esta aplicación está pensada para funcionar con gran rapidez y sin utilizar formulas pesadas.

aleatorio a objetivo

Indicaciones:

  1. Selecciona el rango de celdas que quieres rellenar con los números aleatorios.
  2. Ejecuta la aplicación y considera lo siguiente:
    OBJETIVO: Número o suma objetivo con o sin decimales que deseas obtener.
    DECIMALES: Número de decimales a utilizar en las cifras aleatorias.
    VAR %: Variación en porcentaje (a menos porcentaje se asemejan los valores aleatorios entre sí).

Código empleado en el formulario:

Private Sub lbl_generar_Click()
Application.ScreenUpdating = False

num = frm_alob.txt_num
por = frm_alob.txt_por
dec = frm_alob.txt_dec

If IsNumeric(num) And IsNumeric(por) And IsNumeric(dec) Then

    Dim matr()
    ncel = Selection.Count
    ReDim matr(0 To ncel - 1)
    
    k = 0
    Do
        suma = 0
        suma2 = 0
        
        For i = 0 To ncel - 1
            matr(i) = (por / 100) * Rnd() + (1 - por / 100)
            suma = suma + matr(i)
        Next i
        
        j = 0
    
        If frm_alob.txt_dec = "" Then
            For Each Rng In Selection
                Rng.Value = (num * matr(j)) / suma
                suma2 = suma2 + Rng.Value
                j = j + 1
            Next Rng
        Else
            For Each Rng In Selection
                Rng.Value = Round(((num * matr(j)) / suma), dec)
                suma2 = suma2 + Rng.Value
                j = j + 1
            Next Rng
        End If
    
    k = k + 1
    If k > 100 Then
    MsgBox "Demasiados intentos, calcule manualmente"
    Exit Do
    End If
    
    Loop Until suma2 = Val(num)

End If

Application.ScreenUpdating = True
End Sub

Etiquetas:, , , , ,

"Trackback" Enlace desde tu web.

M. Vizcarra

Ing. Industrial, egresado de la Facultad de Ingeniería Industrial y de Sistemas de la Universidad Nacional Hermilio Valdizán de Huánuco, Perú.

Deja un comentario