Saludos a Tod@s los Foreros

Aquí vuelvo con otro problema, esta es una Macro que encontré hace algún tiempo en el Foro, la colgó el usuario Paco40 el 30/10/2010, le estuvieron ayudando varios de los Master, quisiera ver la posibilidad que se le puedan agregar unas 5 filas como mínimo o hasta 10 como máximo, cada vez que he intentado cambiar algo siempre me da error o me reduce la cantidad de combinaciones, pero no logro aumentar las Filas.

Como siempre muchas gracias por su tiempo que emplean en mis Temas.

Un Cordial Saludo

Lázaro.

AÑADIR FILAS.zip

Saludos.

Revisa adjunto, espero sea lo que necesitas.

Atte.

joshua

AÑADIR FILAS_joshua.rar

Hola Joshua

En primer lugar muchas gracias por dedicarme parte de tu tiempo compañero, me he demorado un poco en contestarte ya que por más que intento fallan algunas cosas en la Macro, he probado y realmente no logro que tenga en cuenta a partir de la Fila 12 de la Tabla, incluso cuando hay muchos valores solo llega a la 10, yo me he tomado el atrevimiento de comentarte algunas cosas en el Adjunto, pero de antemano quiero que tengas presente que en Macro estoy frito, más bien lo que hice fue comparar la evolución que ha tenido esta Macro y comentarte algunas cosas que para mi puedan tener algo de lógica, así que si vez alguna barrabasada escrita me disculpas.

En el adjunto coloco la Macro que yo colgué y la tuya para comparar un poco mejor, si no logro explicar lo que necesito sin problema alguna me lo comentas y lo vuelvo a exponer.

Una vez más, Muchas Gracias por dedicarme tiempo.

Un Cordial Saludo

Lázaro.

1-AÑADIR FILAS_joshua.zip

Saludos Foreros

Bueno he tratado en lo posible de poder dar solución a la Macro y después de muchísimas pruebas, he colocado para que me ejecute 15 Filas como máximo, pero me sale un reporte donde las mismas combinaciones Teóricas que se generan se Eliminan, quisiera saber si se puede subsanar este error, en el adjunto explico, desde ya muchas gracias por el tiempo que me puedan dedicar.

Un Cordial Saludo

Lázaro.

2-AÑADIR FILAS.zip

Saludos a Tod@s

Bueno después varios días más tratando desentrañar esta Macro por fin he logrado algo ya me genera las 274 400 combinaciones.

La duda es que solo me reconoce 10 Filas he intentado de mil maneras y nada, quisiera como mínimo que me reconozca 15 Filas en las columnas B y L, las columnas intermedias si fuese necesario con 5 Filas, aquí les dejo el texto de la última opción de la Macro por si alguien me puede ayudar y en el adjunto la nueva configuración de los datos.

Sub GneraCombinacionesII()

  Dim V(90), x, y, z
  Application.DisplayStatusBar = True
  Application.StatusBar = ""
  For x = 1 To 90: V(x) = "": Next x

  Range("B25:L1000000").ClearContents
  'Guardamos los números en un array
  z = 1
  For y = 2 To 18 Step 2
     For x = 5 To 14
        V(z) = ActiveSheet.Cells(x, y)
        z = z + 1
     Next x
  Next y

  'Buscamos números repetidos
  For x = 1 To 90
     For y = x + 1 To 90
        If V(x) > 0 Then
           If V(x) = V(y) Then
              Cadena = Cadena & " " & V(y)
              V(y) = 0
           End If
        End If
     Next
  Next  
  'Generamos combinaciones
  'ActiveSheet.Range("A2:B1000000").ClearContents
  Application.ScreenUpdating = False
  x = 25
  For a = 1 To 10:   For b = 11 To 20:   For c = 21 To 30
     For d = 31 To 40: For e = 41 To 50: For f = 51 To 90
        If reales > 300000 Then
           MsgBox "Solo se han generado las primeras 275.000 combinaciones.", vbInformation
           GoTo Report
        End If
        If V(a) <> "" And V( <> "" And V(c) <> "" And V(d) <> "" And V(e) <> "" And V(f) <> "" Then
           If Total Mod 1000 = 0 Then Application.StatusBar = "Combinación: " & Total
           Total = Total + 1
           If V(a) > 0 And V( > 0 And V(c) > 0 And V(d) > 0 And V(e) > 0 And V(f) > 0 Then
              reales = reales + 1
              y = reales Mod 6
              If y = 0 Then y = 6
              ActiveSheet.Cells(x, y * 2) = V(a) & " " & V( & " " & V(c) & " " & V(d) & " " & V(e) & " " & V(f)
              If y = 6 Then x = x + 1
           End If
        End If
     Next: Next: Next
  Next: Next: Next
  'Visualizamos report de proceso
  Report:
  ActiveSheet.Range("B4").Activate
  If Cadena <> "" Then
     MsgBox "Números duplicados: " & Cadena & Chr(10) & _
            "Combinaciones teóricas:    " & Total & Chr(10) & _
            "Combinaciones generadas:  " & reales & Chr(10) & _
            "Combinaciones eliminadas: " & Total - reales & Chr(10), vbExclamation
  Else
     MsgBox "Combinaciones generadas: " & reales & Chr(10), vbInformation
  End If
  Application.DisplayStatusBar = False
  End Sub
[/PHP]

Saludos Cordiales

Lázaro.

3-AÑADIR FILAS.zip