Visual Basic para Aplicaciones - Macro para Combinaciones y Mezclas Adjunto(s)

Life is soft - evento anual de software empresarial
 
Vista:
sin imagen de perfil
Val: 21
Ha mantenido su posición en Visual Basic para Aplicaciones (en relación al último mes)
Gráfica de Visual Basic para Aplicaciones

Macro para Combinaciones y Mezclas Adjunto(s)

Publicado por Romssel (7 intervenciones) el 04/05/2017 02:47:40
Hola...

Tengo un problema existencial muy grande. Necesito hacer toda una combinación de datos. En el archivo anexo viene la hoja en donde estan las diferentes combinaciones de 5 Letras y niguna de las opciones se repite! Lo q necesito hacer es esto mismo pero para diferente cantidad (6, 7, 8, etc).
Habrá alguna macro que pueda realizar este tipo de acciones?

Gracias de antemano
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

Macro para Combinaciones y Mezclas Adjunto(s)

Publicado por JuanC (564 intervenciones) el 05/05/2017 12:43:21
... soy curioso, ¿para qué son las combinaciones?

te dejo lo que hice, ya dirás si te sirvió...

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
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
Option Explicit
Option Base 1
 
'//By JuanC - May. 2017
 
Sub mix_uplas()
Dim v As Variant, col As New Collection, col2 As New Collection
Dim i&, j&, k&, s$, n&, u&, m&, a$, b$, flg As Boolean
 
With Application
     .ScreenUpdating = False
     .EnableEvents = False
     .Calculation = xlCalculationManual
End With
 
'//IMPORTANTE: El código no está optimizado!! (ni creo que sea 'la manera' de hacerlo, pero funciona...)
'//Al agregar más letras la cantidad de combinaciones crece exponencialmente
'//y el proceso se hace mucho más lento. Hasta 10 elementos va sin problemas...
 
'          1    2    3    4    5    6    7    8    9   10
v = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J")
n = UBound(v)
 
Range("A:Z").EntireColumn.Clear
For j = 1 To n
    Range("A1").Offset(0, j - 1).Value = v(j)
Next
 
For i = 1 To n
    For j = i + 1 To n
        s = v(i) & v(j)
        col.Add s
    Next
Next
 
On Error Resume Next
 
u = 2
begin:
m = col.Count
For i = 1 To n
    For j = 1 To m
        If VBA.Len(col.Item(j)) = u Then
           If VBA.InStr(1, col.Item(j), v(i)) = 0 Then
              s = v(i) & col.Item(j)
              s = st(s)
              col.Add s, s
           End If
        End If
    Next
Next
u = u + 1
If u + 1 < n Then GoTo begin
 
m = col.Count
For i = 1 To m
    a = col.Item(i)
    For j = 1 To m
        If i <> j Then
           b = col.Item(j)
           If VBA.Len(a) >= VBA.Len(b) Then
              flg = False
              For k = 1 To VBA.Len(a)
                  If VBA.InStr(1, b, VBA.Mid(a, k, 1)) > 0 Then
                     flg = True
                     Exit For
                  End If
              Next
              If Not flg Then
                 col.Add " " & a & " " & b & " "
              End If
           End If
        End If
    Next
Next
 
For j = 1 To n
    col.Add v(i)
Next
 
m = col.Count
For i = 1 To m
    s = col.Item(i)
    For j = 1 To n
        If VBA.InStr(1, s, v(j)) = 0 Then
           s = s & " " & v(j) & " "
        End If
    Next
    col.Add s
Next
 
u = col.Count
For i = 1 To u
    v = VBA.Split(col.Item(i), " ")
    Call SG(v)
    s = ""
    m = UBound(v)
    For j = 1 To m
        If VBA.Trim(v(j)) <> "" Then
           s = s & VBA.Trim(v(j)) & "-"
        End If
    Next
    If s <> "" Then
       s = VBA.Left(s, VBA.Len(s) - 1)
       col2.Add s, s
    End If
Next
 
j = 0
m = col2.Count
For i = 1 To m
    s = col2.Item(i)
    s = VBA.Replace(s, "-", "")
    If VBA.Len(s) >= n Then
       s = (col2.Item(i))
       v = VBA.Split(s, "-")
       u = UBound(v)
       For k = 0 To u
           Range("A2").Offset(j, k).Value = v(k)
       Next
       j = j + 1
    End If
Next
 
With Application
     .ScreenUpdating = True
     .EnableEvents = True
     .Calculation = xlCalculationAutomatic
End With
 
End Sub
 
Private Function st(str As String) As String
Dim i%, ln%, s() As String
ln = VBA.Len(str)
ReDim s(1 To ln) As String
For i = 1 To ln
    s(i) = VBA.Mid(str, i, 1)
Next
Call SStr(s)
For i = 1 To ln
    st = st & s(i)
Next
End Function
 
Private Sub SStr(ByRef ar() As String)
Dim i%, j%, s$
Dim m%, n%
m = UBound(ar)
n = LBound(ar)
For i = m To n Step -1
    For j = n + 1 To i
        If ar(j - 1) > ar(j) Then
           s = ar(j - 1)
           ar(j - 1) = ar(j)
           ar(j) = s
        End If
    Next
Next
End Sub
 
Private Sub SG(ByRef ar As Variant)
Dim i%, j%, s$
Dim m%, n%
m = UBound(ar)
n = LBound(ar)
For i = m To n Step -1
    For j = n + 1 To i
        If VBA.Mid(ar(j - 1), 1, 1) > VBA.Mid(ar(j), 1, 1) Then
           s = ar(j - 1)
           ar(j - 1) = ar(j)
           ar(j) = s
        End If
    Next
Next
End Sub
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
1
Comentar
sin imagen de perfil
Val: 21
Ha mantenido su posición en Visual Basic para Aplicaciones (en relación al último mes)
Gráfica de Visual Basic para Aplicaciones

Macro para Combinaciones y Mezclas Adjunto(s)

Publicado por Romssel (7 intervenciones) el 06/05/2017 00:22:07
Que tal mi estimado Juan.....

En verdad te agradezco mucho tu gran ayuda!!!.... efectivamente es lo q yo tnto estaba buscando!!!.

Te comento, la razón por la q necesito esta macro es para hacer la combinación de diferentes nombres, básicamente para que a cada letra asignarle un nombre (en mi caso sería el nombre de una agencia), hacer la combinacion de varias agencias para que así podamos saber cual es la ruta conveniente q debemos de tomar.

Definitivamente agredezco tanto tu gran apoyo pq en verdad me sacaste de un problema muchísimo muy grande.

Muchas gracias!!!

Romssel
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

Macro para Combinaciones y Mezclas Adjunto(s)

Publicado por JuanC (564 intervenciones) el 06/05/2017 00:51:21
me alegra que haya servido, valió la pena el quebradero de cabeza! jeje
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
1
Comentar
sin imagen de perfil
Val: 21
Ha mantenido su posición en Visual Basic para Aplicaciones (en relación al último mes)
Gráfica de Visual Basic para Aplicaciones

Macro para Combinaciones y Mezclas Adjunto(s)

Publicado por Romssel (7 intervenciones) el 26/05/2017 05:08:40
Mi estimado Juan...... nuevamente molestandote...... (una disculpa antes que nada)....

Te comento, en esta misma macro que me hiciste el favor de ayudarme, ando haciendo otra parte de la macro (la cual es muy grande por cierto). Dicha parte o dicha sección, estoy haciendo tambien que durante la ejecución de la macro, me haga o me agregue de manera automática tanto OptionButton como Labels y Frames durante la ejecución de la propia macro, incluso pude haber hecho tambien de que se creara la FORMA de manera automática, pero no lo hice, en fin.

Lo q quiero saber es si tu sabes una forma en como poder nombrar tanto a los OptionButton como a los Labels y Frames. Te lo pregunto pq no he encontrado la manera en como hacerlo, vi algunas páginas en donde dice como, sin embargo, lo hago pero no me permite ponerle el nombre a un OptionButton o a un label.... pq has de cuenta q al ejecutarlo si me los crea perfectamente pero lo q tengo q hacer es de que al yo cambiar el valor de un OptionButon y apretarle al botón SAVE, y tengo q hacer q ese valor se guarde en una base de datos de Access, y es lo que no encuentro la manera de hacerlo. Te proporciono el Codigo para que lo veas y si tienes tiempo y oportunidad me digas que puedo hacer.

Gracias de antemano!




Set mcolEvents = New Collection

tot = Range("a1").End(xlDown).Row


n = tot
h = 1
j = 1


Windows("CATALOG TYPE TRANSPORT.xlsx").Activate
Windows("CATALOG TYPE TRANSPORT.xlsx").WindowState = xlMaximized
med = 35

If n > 1 Then
For i = 1 To n

j = 1

Set ctl = UF_Equipment.Controls.Add("Forms.label.1")
Windows("CATALOG TYPE TRANSPORT.xlsx").Activate
Windows("CATALOG TYPE TRANSPORT.xlsx").WindowState = xlMaximized
ctl.Top = i * med
ctl.Left = 30
ctl.Caption = Range("a" & i)
ctl.Width = 150

Windows("CATALOG TYPE TRANSPORT.xlsx").Activate
Windows("CATALOG TYPE TRANSPORT.xlsx").WindowState = xlMaximized
Windows("FORMATO FINAL").Activate
Windows("FORMATO FINAL").WindowState = xlMinimized
Windows("CATALOG TYPE TRANSPORT.xlsx").Activate
Windows("CATALOG TYPE TRANSPORT.xlsx").WindowState = xlMaximized
Range("a" & i).Select
Tractos(i) = ActiveCell
Range("b" & i).Select
Status(j) = ActiveCell

Dim cCntrl(100) As Control
Set cCntrl(j) = Me.Controls.Add("Forms.TextBox.1", "MyTextBox" & i, True)
With cCntrl(j)
.Width = 50
.Height = 20
.Top = h * med - 10
.Left = 300
.ZOrder (0)
.Text = Status(j)

Debug.Print cCntrl(j).Name
End With

Set NewFrame = Me.Controls.Add("Forms.Frame.1")

With NewFrame
.Top = h * med - 10
.Left = 140
.Height = 30
.Width = 140
End With

Set TB = NewFrame.Controls.Add("Forms.optionbutton.1")
TB.Top = 4
TB.Left = 25
TB.Caption = "OK"
'med = 32
Range("b" & i).Select
If ActiveCell = "ok" Then
TB.Value = 1
cCntrl(j).Text = "OK"
End If
psnom1 = TB.Name

'psnom = NewFrame.Controls.Item("Forms.optionbutton.1").Name
'Debug.Print psnom1
opts1(i) = psnom1


Set TB = NewFrame.Controls.Add("Forms.optionbutton.1") '"btn" & i & "_b"
TB.Top = 4
TB.Left = 80
TB.Caption = "NG"
'med = 32
Range("b" & i).Select
If ActiveCell = "ng" Then
TB.Value = 1
End If
psnom2 = TB.Name
'Debug.Print psnom2
opts2(j) = psnom2

h = h + 1
j = j + 1


Next i
End If


butTop = i * med + 20

Set ctlbut = Me.Controls.Add("Forms.CommandButton.1", "butSave" & i)

ctlbut.Top = butTop: ctlbut.Left = 80
ctlbut.Caption = "SAVE"
butTop = butTop + 20

ReDim Preserve ButArray(1 To i)
'Set ButArray(i).butSave = ctlbut


butTop2 = i * med + 20

Set ctlbut2 = Me.Controls.Add("Forms.CommandButton.1", "butCancel" & i)

ctlbut2.Top = butTop2: ctlbut2.Left = 190
ctlbut2.Caption = "CANCEL"
butTop2 = butTop2 + 20

ReDim Preserve ButArray(1 To i)
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

Macro para Combinaciones y Mezclas Adjunto(s)

Publicado por JuanC (564 intervenciones) el 26/05/2017 12:48:35
pues la verdad que no veo el inconveniente...

1
2
3
4
5
6
7
8
9
Dim lbl As MSForms.Label
Set lbl = Me.Controls.Add("Forms.Label.1")
With lbl
     .Name = "label"
     .Caption = "lalala"
     .Left = 10
     .Top = 10
     .Visible = True
End With
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
sin imagen de perfil
Val: 21
Ha mantenido su posición en Visual Basic para Aplicaciones (en relación al último mes)
Gráfica de Visual Basic para Aplicaciones

Macro para Combinaciones y Mezclas Adjunto(s)

Publicado por Romssel (7 intervenciones) el 26/05/2017 18:34:59
Gracias por tu respuesta, te comento q eso si lo se hacer y no es problema la verdad, sin embargo, el caso es crearlo con arreglos, es decir, crear "n" número de LABELS, TextBox y OptionButton,tal y como te lo muestro en la imagen. Eso ya lo se hacer, ya lo puedo realizar, incluso esos datos como te podrás dar cuenta los toma de la hoja de Excel. Al igual, te comento que a parte de crearme los controles, en el archivo que se encuentra detras del formulario, me crea de la misma manera un Modulo junto con su código (pantalla 2).

Todo eso ya me lo crea automáticamente, lo que tengo duda y en verdad si no sé como hacer es de que si por ejemplo yo hago el cambio de un OptionButton de la pantalla1 supongamos de la opción que dice C2 - PU 1.5 TON la cambio de NG a OK, es lo q no se como guardar o como almacenar en la base de datos de access ya que los nombres de cada campo (optButton) no "existe", o no me los guarda con esos nombres al momento de yo crearlos y el problema es de q no se con que nombre se crean.

En la pantalla 4 es donde te muestro el codigo donde viene la parte que crea todos los controles del formulario, pero si te fijas los crea dentro de un FOR, y al ejecutar esa macro de la pantalla 4, me da como resultado lo de la pantalla 1, pero el problema es (como te comentaba), de que si yo hago una modificacion en un OPTIONBUTTON, como le puedo hacer que al darle click en SAVE, me lo guarde en la base de datos de ACCESS.

Gracias de antemano.

pantalla1
pantalla2
pantalla3
pantalla4
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

Macro para Combinaciones y Mezclas Adjunto(s)

Publicado por JuanC (564 intervenciones) el 26/05/2017 19:21:38
la verdad que no me queda del todo claro el problema...
creo que la clave está en el código que guarda los datos
sólo se trata de guardar el valor True/False de cada OptionButton
podrías aprovechar la propiedad Tag del objeto además de su Nombre
con un bucle que recorra todos los objetos podés identificar bien a cada uno y tomar su valor... en fin, no entiendo! jaja
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
1
Comentar
sin imagen de perfil
Val: 21
Ha mantenido su posición en Visual Basic para Aplicaciones (en relación al último mes)
Gráfica de Visual Basic para Aplicaciones

Macro para Combinaciones y Mezclas Adjunto(s)

Publicado por Romssel (7 intervenciones) el 26/05/2017 23:07:18
No te preocupes mi buen amigo :)...... lograré hacerlo y luego te digo como para q tu tambien ya tengas la idea ;)...

Muchísimas gracias nuevamente por todo!!!
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