Programa para hacer combinaciones de numeros

[Maxi46]

Exacto, en el link que yo dejé (http://underc0de.org/foro/dudas-generales-121/programa-que-haga-combinaciones/), hay algo similar pero solo hace 8 combinaciones yo necesito que me dé las 28.

[Maxi46]

Ya lo solucione con una macro en excel.

[zapato]

hola muy buenas me gustaria saber si algun programa o alguna aplicacion que me de los casi 14 millones de combinaciones que hay en la bonoloto en un listado que pueda imprimir o poder trabajar luego con ese listado soy muy negado para esto de la informatica gracias espero vuestra ayuda

[zapato]

hola muy buenas maxi46 me puedes decir como puedo hacerlo con una macro gracias

[pkj]

Aqui os dejo una solucion (o eso creo) en VB6. No sera la mas rápida pero parece que cumple su cometido.
Hace 6 años estuve experimentando con esto (por gusto) y consegui hacer una busqueda de combinaciones ordenadas (sin repeticiones).

En principio solo podias pedir grupos de N numeros, usando los numeros del 1 al X. Siempre desde el 1 en adelante.
Con un pequeño cambio que se me ha ocurrido mientras lo revisaba, ahora puedes pedir grupos de N numeros, usando los numeros de una lista, vayan seguidos o no, y esten ordenados o no lo esten.
Vamos, que ahora admite cualquier cosa.
De hecho puedes usar palabras en lugar de numeros, y se crearan todas las combinaciones posibles (siempre sin repeticiones).
El resultado lo devuelve en una matriz de cadena.

En fin, solo necesita un form con un listbox y un commandbutton.
Echad un ojo al command1 para ver como se usa y yasta.
Dejo los comentarios que puse en su dia por si os sirven de algo (a mi me dejan loco )

Código [Seleccionar] Expandir


Option Explicit

Dim Parar As Integer

Private Sub Form_Load()
 Parar = 1
End Sub

Private Sub Command1_Click()
 On Local Error Resume Next
 If Parar = 0 Then Parar = 1: Exit Sub

 ' valores a insertar
 Static TamGrupos As Integer ' Tamaño de los grupos
 Static ListaDeNumeros As String ' lista de numeros separados por comas
 If ListaDeNumeros = "" Then ListaDeNumeros = "1,18,23,24,28,35,47"
 If TamGrupos = 0 Then TamGrupos = 3
 ' podemos pedirselos al usuario:
 Dim Respuesta As String
 Respuesta = InputBox("¿Que tamaño deben tener los grupos?", "Tamaño Grupos", TamGrupos)
 If Val(Respuesta) > 0 Then TamGrupos = Respuesta
 Respuesta = InputBox("¿Que números quieres usar? (uno o varios números separados por comas)", "Lista de números", ListaDeNumeros)
 If InStr(1, Respuesta, ",") Or Val(Respuesta) > 0 Then ListaDeNumeros = Respuesta
 
 Dim Matriz() As String ' matriz donde recibiremos la lista
 CreaGrupos TamGrupos, ListaDeNumeros, Matriz
 
 'Aqui manipulas la matriz como quieras
 ' por ejemplo pasandola a un listbox
 List1.Clear
 List1.Visible = False
 Dim F As Long
 For F = 0 To UBound(Matriz)
   List1.AddItem Matriz(F)
   DoEvents
 Next F
 List1.Visible = True

End Sub


Private Function CalculaTotal(ByVal TamGrupos As Integer, ByVal MaximoValor As Integer)' As Long
 Dim C1 As Double
 Dim C2 As Double
 Dim F As Double
 On Local Error Resume Next
 C1 = 1
 C2 = 1
 For F = 1 To TamGrupos
    C1 = C1 * F
 Next F

 For F = MaximoValor To (MaximoValor - (TamGrupos - 1)) Step -1
    C2 = C2 * F
 Next F
 CalculaTotal = C2 / C1

End Function


Private Sub CreaGrupos(ByVal TamGrupos As Integer, ByVal TopeOListaDeNumerosSeparadosPorComas As String, ByRef ListaDevuelta() As String)
' Busqueda de combinaciones.
' Dados los numeros de TopeOListaDeNumerosSeparadosPorComas,
' saca todos los grupos no repetidos de "TamGrupos" numeros
' y los devuelve en la matriz Lista()
' Por repetido se entiende que "1,2,3" es igual que "1,3,2", igual que "2,1,3", etc...
' Ejm: 1,2,3,4 de 2 en 2 = 6 combinaciones
' 1,2 - 1,3 - 1,4 - 2,3 - 2,4 - 3,4
' Opcionalmente, en lugar de una lista de números puedes poner un solo número.
' En ese caso la listadenumeros seran los números desde el 1 hasta el que pongas.

 Dim F As Double
 Dim Linea As String
 Dim Num As Double
 Dim Total As Double
 Dim Ap() As Double
 Dim MaximoValor As Long

 Dim MatrizDeNumeros() As String
 On Local Error Resume Next
 MatrizDeNumeros = Split(TopeOListaDeNumerosSeparadosPorComas, ",")
 MaximoValor = UBound(MatrizDeNumeros) + 1

 If TamGrupos < 1 Then
   MsgBox "Los grupos deben tener al menos un elemento."
   GoTo Fin
 End If
 
 If MaximoValor = 1 And Val(MatrizDeNumeros(0)) > 0 Then
   MaximoValor = Val(MatrizDeNumeros(0))
   ReDim MatrizDeNumeros(MaximoValor - 1)
   For F = 1 To MaximoValor
     MatrizDeNumeros(F - 1) = F
   Next F
 End If
 
 If MaximoValor < 1 Or TamGrupos > MaximoValor Then
   MsgBox "Tiene que haber al menos " & TamGrupos & " valores en TopeOListaDeNumerosSeparadosPorComas"
   GoTo Fin
 End If
 
 Total = CalculaTotal(TamGrupos, MaximoValor)
 
 ReDim Ap(TamGrupos)
 
 ReDim ListaDevuelta(Total - 1) As String
 Dim Contador As Long
 Contador = -1
 
 Parar = 0

' Cogemos las primeras
 For F = 1 To TamGrupos
   Ap(F) = F
 Next F
 
OtraVez:
 'Preparo la linea con la combinacion
 Linea = ""
 For F = 1 To TamGrupos - 1
   Linea = Linea & MatrizDeNumeros(Ap(F) - 1) & " , "
 Next F
 Linea = Linea & MatrizDeNumeros(Ap(TamGrupos) - 1)
 
 ' Guardo la combiancion
 Contador = Contador + 1
 ListaDevuelta(Contador) = Linea
 
 'Label4.Caption = Contador + 1 ' Muestro el progreso
 
 DoEvents
 If Parar = 1 Then GoTo Fin

 Num = TamGrupos + 1

Repetir1:
 Num = Num - 1  ' Cogemos la apuesta(num) (en principio la ultima)
 
'La aumentamos...
 Ap(Num) = Ap(Num) + 1
 
 ' si es mayor de la cuenta...
 If Ap(Num) > (MaximoValor - (TamGrupos - Num)) Then
   
   ' si es la ap(1) se acaba
   If Num = 1 Then GoTo Fin
   
   ' ...aumentamos la anterior
   GoTo Repetir1
 End If

' Si no llega a su limite se mira si alguna ha llegado
' a su maximo
' Si NUM no apunta a la ultima AP() es que
' alguna ap() ha llegado a su maximo
 ' entonces reiniciamos todas las siguientes...
 If Num <> TamGrupos Then
   For F = Num + 1 To TamGrupos
     '....dandoles el valor de la anterior + 1...
     Ap(F) = Ap(F - 1) + 1
   Next F
 End If
   
 ' ... Y se da por valida
 GoTo OtraVez

Fin:
 Parar = 1
 
End Sub



Saludos