curiosidad

"Rafa" escribió en...

Insisto nuevamente:
Solo trato de saber si hay alguna forma de que en excel se escriban
automaticamente, bien en una hoja o en dos o en tres hojas todas las
combinaciones posibles de la loteria primitiva
ejemplo:
1 - 2 - 3 - 4 - 5 - 6
1 - 2 - 3 - 4 - 5 - 7
1 - 2 - 3 - 4 - 5 - 8
etc, etc.
no se si aun hay alguna duda sobre mi exposicion de problema.
de existir alguna forma de que esto sea posible, si son tan amables de
decirme como, lo agradeceria. Gracias anticipadas a todos por el interes
han tomado en atenderme.
Saludos.

Mira si te sirve esto:
Ponlo en un libro con solo una hoja (Hoja1), eso si, no tengo ni idea del
tiempo q tardara en generar el fichero, pero no me extrañaria que fueran
horas!!!!

Const CTE_MAX_NUM As Integer = 10 ''' Pon aquí la bola máxima (49)
Const CTE_NUMEROS As Integer = 4 ''' Pon aquí el nº de bolas (6)

Public Sub LOTERIA()
Dim nNum As Integer
Dim oSh As Worksheet
Dim nInicio As Double, nFinal As Double

On Error Resume Next
nInicio = Timer
Set oSh = ActiveWorkbook.Worksheets("Hoja1")
Debug.Print "LOT_PRIM: Inicio: " & nInicio

For nNum = 1 To CTE_MAX_NUM - CTE_NUMEROS + 1
Set oSh = ActiveWorkbook.Worksheets("Hoja1")
oSh.Copy oSh
Set oSh = ActiveSheet
oSh.Name = "LOTERIA_PRIM_" & nNum
oSh.Range("A2").Select
Application.ScreenUpdating = False
Call NumeroSiguiente(nNum, 1)
ActiveCell.EntireRow.Delete
Application.ScreenUpdating = True
Next nNum

nFinal = Timer
Debug.Print "LOT_PRIM: Final : " & nFinal
End Sub

Private Sub NumeroSiguiente(ByVal Numero As Integer, ByVal Posicion As
Integer)
''' If Numero > CTE_MAX_NUM Then Exit Sub ''' Comprobación extra...

If Posicion >= CTE_NUMEROS Then
ActiveCell.Offset(0, CTE_NUMEROS - 1).Value = Numero
ActiveCell.EntireRow.Copy ActiveCell.Offset(1, 0).EntireRow
ActiveCell.Offset(1, 0).Select
Exit Sub
Else
ActiveCell.Offset(0, Posicion - 1).Value = Numero
End If

Do While Numero < CTE_MAX_NUM
Numero = Numero + 1
Call NumeroSiguiente(Numero, Posicion + 1)
Loop
End Sub

Saludos

Lo que yo decía, se puede hacer pero... no se yo... cuanto tardará :-)

"Luis Garcia" escribió...

"Rafa" escribió en...
> Insisto nuevamente:
> Solo trato de saber si hay alguna forma de que en excel se escriban
> automaticamente, bien en una hoja o en dos o en tres hojas todas las
> combinaciones posibles de la loteria primitiva
> ejemplo:
> 1 - 2 - 3 - 4 - 5 - 6
> 1 - 2 - 3 - 4 - 5 - 7
> 1 - 2 - 3 - 4 - 5 - 8
> etc, etc.
> no se si aun hay alguna duda sobre mi exposicion de problema.
> de existir alguna forma de que esto sea posible, si son tan amables de
> decirme como, lo agradeceria. Gracias anticipadas a todos por el interes
> han tomado en atenderme.
> Saludos.

Mira si te sirve esto:
Ponlo en un libro con solo una hoja (Hoja1), eso si, no tengo ni idea del
tiempo q tardara en generar el fichero, pero no me extrañaria que fueran
horas!!!!

Const CTE_MAX_NUM As Integer = 10 ''' Pon aquí la bola máxima

(49)

Const CTE_NUMEROS As Integer = 4 ''' Pon aquí el nº de bolas

(6)

Public Sub LOTERIA()
Dim nNum As Integer
Dim oSh As Worksheet
Dim nInicio As Double, nFinal As Double

On Error Resume Next
nInicio = Timer
Set oSh = ActiveWorkbook.Worksheets("Hoja1")
Debug.Print "LOT_PRIM: Inicio: " & nInicio

For nNum = 1 To CTE_MAX_NUM - CTE_NUMEROS + 1
Set oSh = ActiveWorkbook.Worksheets("Hoja1")
oSh.Copy oSh
Set oSh = ActiveSheet
oSh.Name = "LOTERIA_PRIM_" & nNum
oSh.Range("A2").Select
Application.ScreenUpdating = False
Call NumeroSiguiente(nNum, 1)
ActiveCell.EntireRow.Delete
Application.ScreenUpdating = True
Next nNum

nFinal = Timer
Debug.Print "LOT_PRIM: Final : " & nFinal
End Sub

Private Sub NumeroSiguiente(ByVal Numero As Integer, ByVal Posicion As
Integer)
''' If Numero > CTE_MAX_NUM Then Exit Sub ''' Comprobación extra...

If Posicion >= CTE_NUMEROS Then
ActiveCell.Offset(0, CTE_NUMEROS - 1).Value = Numero
ActiveCell.EntireRow.Copy ActiveCell.Offset(1, 0).EntireRow
ActiveCell.Offset(1, 0).Select
Exit Sub
Else
ActiveCell.Offset(0, Posicion - 1).Value = Numero
End If

Do While Numero < CTE_MAX_NUM
Numero = Numero + 1
Call NumeroSiguiente(Numero, Posicion + 1)
Loop
End Sub

Saludos

Existen un par de problemas logisticos

En primer lugar Memoria. En mi ordenador Excel da un aviso de Falta de
memoria a los 15 minutos más o menos y por otro lado está la limitación de
65000 y pico líneas que tiene Excel.

Tan sólo combinaciones que comienzan por 1 ya hay más de 65000 y la macro
pretende escribirlas todas en una sola hoja.

A ver... vamos a hacer un par de cuentas.

Nos hacen falta 13.983.816 * 6 celdas
Excel tiene capacidad para albergar 65536 * 256 celdas en cada hoja
de modo que rellenando TODAS las celdas posibles de cada hoja harían
falta...

¡¡¡Sólo 6 Hojas!!!

Uf ahora no tengo tiempo... a ver si esta tarde me pongo con ello :-)

"Individuo Desconocido" escribió en el mensaje
news:

Lo que yo decía, se puede hacer pero... no se yo... cuanto tardará :-)

"Luis Garcia" escribió...
> "Rafa" escribió en...
> > Insisto nuevamente:
> > Solo trato de saber si hay alguna forma de que en excel se escriban
> > automaticamente, bien en una hoja o en dos o en tres hojas todas las
> > combinaciones posibles de la loteria primitiva
> > ejemplo:
> > 1 - 2 - 3 - 4 - 5 - 6
> > 1 - 2 - 3 - 4 - 5 - 7
> > 1 - 2 - 3 - 4 - 5 - 8
> > etc, etc.
> > no se si aun hay alguna duda sobre mi exposicion de problema.
> > de existir alguna forma de que esto sea posible, si son tan amables de
> > decirme como, lo agradeceria. Gracias anticipadas a todos por el

interes

> > han tomado en atenderme.
> > Saludos.
>
> Mira si te sirve esto:
> Ponlo en un libro con solo una hoja (Hoja1), eso si, no tengo ni idea

del

> tiempo q tardara en generar el fichero, pero no me extrañaria que fueran
> horas!!!!
>
> Const CTE_MAX_NUM As Integer = 10 ''' Pon aquí la bola máxima
(49)
> Const CTE_NUMEROS As Integer = 4 ''' Pon aquí el nº de bolas
(6)
>
> Public Sub LOTERIA()
> Dim nNum As Integer
> Dim oSh As Worksheet
> Dim nInicio As Double, nFinal As Double
>
> On Error Resume Next
> nInicio = Timer
> Set oSh = ActiveWorkbook.Worksheets("Hoja1")
> Debug.Print "LOT_PRIM: Inicio: " & nInicio
>
> For nNum = 1 To CTE_MAX_NUM - CTE_NUMEROS + 1
> Set oSh = ActiveWorkbook.Worksheets("Hoja1")
> oSh.Copy oSh
> Set oSh = ActiveSheet
> oSh.Name = "LOTERIA_PRIM_" & nNum
> oSh.Range("A2").Select
> Application.ScreenUpdating = False
> Call NumeroSiguiente(nNum, 1)
> ActiveCell.EntireRow.Delete
> Application.ScreenUpdating = True
> Next nNum
>
> nFinal = Timer
> Debug.Print "LOT_PRIM: Final : " & nFinal
> End Sub
>
> Private Sub NumeroSiguiente(ByVal Numero As Integer, ByVal Posicion As
> Integer)
> ''' If Numero > CTE_MAX_NUM Then Exit Sub ''' Comprobación

extra...

>
> If Posicion >= CTE_NUMEROS Then
> ActiveCell.Offset(0, CTE_NUMEROS - 1).Value = Numero
> ActiveCell.EntireRow.Copy ActiveCell.Offset(1, 0).EntireRow
> ActiveCell.Offset(1, 0).Select
> Exit Sub
> Else
> ActiveCell.Offset(0, Posicion - 1).Value = Numero
> End If
>
> Do While Numero < CTE_MAX_NUM
> Numero = Numero + 1
> Call NumeroSiguiente(Numero, Posicion + 1)
> Loop
> End Sub
>
> Saludos
>
>
>
>
>
>

"Individuo Desconocido" escribió en...

Existen un par de problemas logisticos

En primer lugar Memoria. En mi ordenador Excel da un aviso de Falta de
memoria a los 15 minutos más o menos y por otro lado está la limitación de
65000 y pico líneas que tiene Excel.

Por eso he divido las combinaciones por hojas dependiendo del numero en
que empiezen, pero no calcule cuantas eran necesarias para el 1 !!! 0:-)

Lo de la memoria esta mas complicado, quizas se deberia guardar por libros
e irlos cerrando, porque si 'todo' se queda en memoria...

Uf ahora no tengo tiempo... a ver si esta tarde me pongo con ello :-)

Yo tampoco, ahora mismo desconecto :-), pero fijate que el 'truco' para
copiar
las combinaciones en la celda esta ActiveCell, y en las lineas:

ActiveCell.EntireRow.Copy ActiveCell.Offset(1, 0).EntireRow
ActiveCell.Offset(1, 0).Select

... para poner mas de 1 combinacion por linea seria algo asi como:

ActiveCell.Resize(1, CTE_NUMEROS).Copy

ActiveCell.Offset(0, CTE_NUMEROS+1).Select ''' (*)
ActiveCell.Paste

(*) pero deberas poner una verificacion de no pasarte de las 255 columnas,
lo cual te lo dejo a ti :-))))

Saludos