Excel - Ejecutar macro en dos o mas hojas

   
Vista:

Ejecutar macro en dos o mas hojas

Publicado por Israel (2 intervenciones) el 26/02/2018 19:55:07
Hola buenas tardes
Tengo el siguiente problema, para llevar a cabo las diferentes combinaciones de 3 productos en diferentes líneas de producción. Por ejemplo si lo hago con 10 líneas, las diferentes combinaciones son cerca de 500,000.00 y si lo hago con 11 supera el millón y en la hoja de Excel no cabe las combinaciones necesitaría que pasen a la siguiente hoja. Espero puedan ayudarme. Gracias de antemano


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
Sub Permutations2()
Dim a As Integer
Dim b As Integer
Dim c As Integer
Dim d As Integer
Dim e As Integer
Dim f As Integer
Dim g As Integer
Dim h As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
n = 1
 
For a = 1 To 3
    For b = 1 To 3
        For c = 1 To 3
            For d = 1 To 3
                        For e = 1 To 3
                            For f = 1 To 3
                            For g = 1 To 3
                            For h = 1 To 3
                            For i = 1 To 3
                            For j = 1 To 3
                            For k = 1 To 3
                            For l = 1 To 3
                            Cells(n, 1).Value = a
                     Cells(n, 2).Value = b
                    Cells(n, 3).Value = c
 
                    Cells(n, 4).Value = d
                    Cells(n, 5).Value = e
              Cells(n, 6).Value = f
              Cells(n, 7).Value = g
              Cells(n, 8).Value = h
              Cells(n, 9).Value = i
              Cells(n, 10).Value = j
              Cells(n, 11).Value = k
              Cells(n, 12).Value = l
 
                    n = n + 1
 
                        Next l
                        Next k
                        Next j
                        Next i
                        Next h
                            Next g
                            Next f
                           Next e
                           Next d
                           Next c
    Next b
Next a
 
End Sub
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder
Imágen de perfil de Antoni Masana

Ejecutar macro en dos o mas hojas

Publicado por Antoni Masana (591 intervenciones) el 27/02/2018 10:16:01
Este código empieza en la primera hoja, cuando se llena pasa a la segundo y si no existe la crea.

En la barra de status, parte inferior derecha de la ventana de Excel muestra la hoja, la línea y el total de permutaciones.
Esto esta entre el For H y el For I .
El DoEvents es para que el windows no se que bloqueado mientras se ejecuta la macro.
Si estas dos cosas puede ser un poco más rápido pero no se gana mucho tiempo.
Al final de la macro hay un Aviso para saber cuando ha finalizado.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
Option Explicit
 
Sub Permutations2()
    Dim a As Integer, b As Integer, c As Integer, d As Integer
    Dim e As Integer, f As Integer, g As Integer, h As Integer
    Dim i As Integer, j As Integer, k As Integer, l As Integer
    Dim m As Integer
 
    Dim Linea As Long, Total As Long, Hoja As Integer, OldStatusBar As Boolean
 
    Application.screenupdating=False
 
    Linea = 1
    Total = 1
    Hoja = 1
    Sheets(Hoja).Select
 
    OldStatusBar = Application.DisplayStatusBar
                   Application.StatusBar = True
 
    For a = 1 To 3
        For b = 1 To 3
            For c = 1 To 3
                For d = 1 To 3
 
                    For e = 1 To 3
                        For f = 1 To 3
                            For g = 1 To 3
                                For h = 1 To 3
                                    DoEvents
                                    Application.StatusBar = "Hoja : " & Hoja & "   " & _
                                                            "Linea: " & Linea & "   " & _
                                                            "Total: " & Total
 
                                    For i = 1 To 3
                                        For j = 1 To 3
                                            For k = 1 To 3
                                                For l = 1 To 3
                                                    For m = 1 To 3
                                                        Cells(Linea, 1).Value = a
                                                        Cells(Linea, 2).Value = b
                                                        Cells(Linea, 3).Value = c
                                                        Cells(Linea, 4).Value = d
                                                        Cells(Linea, 5).Value = e
                                                        Cells(Linea, 6).Value = f
                                                        Cells(Linea, 7).Value = g
                                                        Cells(Linea, 8).Value = h
                                                        Cells(Linea, 9).Value = i
                                                        Cells(Linea, 10).Value = j
                                                        Cells(Linea, 11).Value = k
                                                        Cells(Linea, 12).Value = l
                                                        Cells(Linea, 13).Value = m
 
                                                        Linea = Linea + 1
                                                        Total = Total + 1
 
                                                        If Linea > 2 ^ 20 Then
                                                            Linea = 1
                                                            Hoja = Hoja + 1
                                                            If Hoja > Sheets.Count Then Sheets.Add After:=Sheets(Sheets.Count)
                                                            Sheets(Hoja).Select
                                                        End If
                                                    Next m
                                                Next l
                                            Next k
                                        Next j
                                    Next i
                                Next h
                            Next g
                        Next f
                    Next e
                Next d
            Next c
        Next b
    Next a
    Application.screenupdating=True
 
    DoEvents
    Application.StatusBar = "Hoja : " & Hoja & "   " & _
                            "Linea: " & Linea & "   " & _
                            "Total: " & Total
    MsgBox "Fin de la Macro"
End Sub

Saludos.
\\//_
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
2
Comentar
Imágen de perfil de Antoni Masana

Ejecutar macro en dos o mas hojas

Publicado por Antoni Masana (591 intervenciones) el 27/02/2018 11:30:42
Un comentario al código de la macro anterior.

Lo que hay el las líneas 30-33 tiene efecto sobre el tiempo total de la ejecución de la macro.

Sin esas dos líneas tarda 00:07:52
Con las dos líneas donde estan: 00:08:00
Con las dos líneas donde se asignan las celdas 00:22:20

La diferencia en que en mostrar el número se secuencia en el primer caso lo hace: 0 veces, en el segundo caso 6561 veces y tarda 8 segundos más y en el tercero 1.594.324 veces y tarda el triple de tiempo.
Saludos.
\\//_
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

Ejecutar macro en dos o mas hojas

Publicado por Israel (2 intervenciones) el 01/03/2018 07:36:35
Muchas gracias. Se ejecuto de maravilla voy a analizar varias escenarios pero como lo planteaste me servira mucho. De antemano gracias
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar