Jump to content

permutaciones ingredientes en un producto :O


Recommended Posts

Hola, espero alguien me pueda ayudar con esto que ya no se que hacer,

Necesito lograr lo siguiente:

deseo que se hagan permutaciones de diferentes ingredientes de un producto, pero que tengan reglas para evitar combinaciones que no se usaran nunca, ejemplo:

columnas

A B C

Naranja Limón Cereal

Este es el archivo que utilizo, chequenlo porfavor:

https://www.dropbox.com/sh/8jnoujhurswcfn3/97VoOEtoxw/Combinaciones productos.xlsm

Deseo tener un macro que me permita poner excepciones en sus combinaciones y que no se repitan los ingredientes, ejemplo:

Sandia, Jicama, Jicama, Limón, Sal,

Jicama, Jicama, Sandia, Limón, Sal,

Gracias, muchas gracias.

Link to comment
Share on other sites

Bienvenido al foro:

El tema puede parecer interesante, pero, sin archivo de muestra, y un ejemplo claro de lo que quieres lo tienes muy complicado para que haya respuestas.

Revisa las normas del foro, por favor.

Saludos.

Link to comment
Share on other sites

Perdon, como soy nuevo en el foro ya la regue jeje, pero ya actualice mi publicación y les dejo mi archivo, es un link de dropbox pueden descargarlo sin problemas, muhas gracias por sus respuestas, espero logremos encontrar la solución :D

Link to comment
Share on other sites

Perdon, como soy nuevo en el foro ya la regue jeje, pero ya actualice mi publicación y les dejo mi archivo, es un link de dropbox pueden descargarlo sin problemas, muhas gracias por sus respuestas, espero logremos encontrar la solución :D

mmm... el archivo consigo abrirlo en excel 2003 pero quizá hay alguna cosa que no consigo ver.

A ver si lo he entendido quieres tener combinaciones pero que los ingredientes no se repitan.

Entonces, hay dos opciones o directamente borrar los repetidos antes de buscar combinaciones.

O dentro de las combinaciones. Hacer un filtro antes de apuntar la next combinación.

Sub Combinar()
Application.Calculation = xlCalculationManual
'Range("G2:G1009999").Select
'Selection.ClearContents
Range("G1").Select
Dim i As Integer, j As Integer, k As Integer, l As Integer, m As Integer, UltFilA As Integer, UltFilB As Integer, UltFilC As Integer, UltFilD As Integer, UltFilE As Integer, Aux As Integer
Aux = 2
UltFilA = Range("A65536").End(xlUp).Row
UltFilB = Range("B65536").End(xlUp).Row
UltFilC = Range("C65536").End(xlUp).Row
UltFilD = Range("D65536").End(xlUp).Row
UltFilE = Range("E65536").End(xlUp).Row
For i = 1 To UltFilA
For j = 1 To UltFilB
For k = 1 To UltFilC
For l = 1 To UltFilD
For m = 1 To UltFilE

'Aquí metes el filtro.
'Como de cada columna cojes solo un valor.
'Haces algo así.

If Range("A" & i) <> Range("B" & j) & Range("A" & i) <> Range("C" & K) & Range("A" & i) <> ... todas las combos posibles ... Then

'Aquí pondrá el valor solo si son distintos los valores. Es un coñazo manejar los condicionales de dos en dos pero no se me ocurre otra forma. Si alguien la sabe que lo diga, yo tm estoy interesado.

Range("G" & Aux) = Range("A" & i) & Range("B" & j) & Range("C" & k) & Range("D" & l) & Range("E" & m)
Aux = Aux + 1

End If
Next m
Next l
Next k
Next j
Next i
Application.Calculation = xlCalculationAutomatic
End Sub[/PHP]

Link to comment
Share on other sites

Graxias por la respuesta @michico, estoy probando tu opción, vere que tal nos funciona, y ahora solo faltaria saber como colocarle condiciones para evitar combinaciones con productos que generalmente no se combinan, ejemplo:

Una combinación normal y aceptada es:

Melón, Sandía, Yogurth de fresa, Granola

Preo una combinación nada apetitosa y que no me interesa es:

Melón, Límon, Chile seco, Yogurth de fresa

Ciertamente esta perro esto, pero estoy seguro que lo podemos lograr :D

GRACIAS!!

Link to comment
Share on other sites

A, y otro dato, lo hice con el excel 2010, lo comento para que conozcan la versión que uso, lo voy a guardar con compatibilidad y lo volvere a subir, pero creo que si se puede usar y visualizar igual en el 2003, gracias.

Link to comment
Share on other sites

Mira hice esto, no se si sea la idea que me planteas @michico, pero al utilizar la macro no pasa nada diferente, las combinaciones se generan iguales.



Sub h()
Application.Calculation = xlCalculationManual
Range("G2:G1009999").Select
Selection.ClearContents
Range("G1").Select
Dim i As Integer, j As Integer, k As Integer, l As Integer, m As Integer, UltFilA As Integer, UltFilB As Integer, UltFilC As Integer, UltFilD As Integer, UltFilE As Integer, Aux As Integer
Aux = 2
UltFilA = Range("A65536").End(xlUp).Row
UltFilB = Range("B65536").End(xlUp).Row
UltFilC = Range("C65536").End(xlUp).Row
UltFilD = Range("D65536").End(xlUp).Row
UltFilE = Range("E65536").End(xlUp).Row
For i = 1 To UltFilA
For j = 1 To UltFilB
For k = 1 To UltFilC
For l = 1 To UltFilD
For m = 1 To UltFilE
If Range("A" & i) <> Range("B" & j) & Range("A" & i) <> Range("C" & k) & Range("A" & i) <> Range("D" & l) & Range("A" & i) <> Range("E" & m) Then
If Range("A" & j) <> Range("B" & j) & Range("A" & j) <> Range("C" & k) & Range("A" & j) <> Range("D" & l) & Range("A" & j) <> Range("E" & m) Then
If Range("A" & k) <> Range("B" & j) & Range("A" & k) <> Range("C" & k) & Range("A" & k) <> Range("D" & l) & Range("A" & k) <> Range("E" & m) Then
If Range("A" & l) <> Range("B" & j) & Range("A" & l) <> Range("C" & k) & Range("A" & l) <> Range("D" & l) & Range("A" & l) <> Range("E" & m) Then
If Range("A" & m) <> Range("B" & j) & Range("A" & m) <> Range("C" & k) & Range("A" & m) <> Range("D" & l) & Range("A" & m) <> Range("E" & m) Then
If Range("B" & i) <> Range("A" & j) & Range("B" & i) <> Range("C" & k) & Range("B" & i) <> Range("D" & l) & Range("B" & i) <> Range("E" & m) Then
If Range("B" & j) <> Range("A" & j) & Range("B" & j) <> Range("C" & k) & Range("B" & j) <> Range("D" & l) & Range("B" & j) <> Range("E" & m) Then
If Range("B" & k) <> Range("A" & j) & Range("B" & k) <> Range("C" & k) & Range("B" & k) <> Range("D" & l) & Range("B" & k) <> Range("E" & m) Then
If Range("B" & l) <> Range("A" & j) & Range("B" & l) <> Range("C" & k) & Range("B" & l) <> Range("D" & l) & Range("B" & l) <> Range("E" & m) Then
If Range("B" & m) <> Range("A" & j) & Range("B" & m) <> Range("C" & k) & Range("B" & m) <> Range("D" & l) & Range("B" & m) <> Range("E" & m) Then
If Range("C" & i) <> Range("A" & j) & Range("C" & i) <> Range("B" & k) & Range("C" & i) <> Range("D" & l) & Range("C" & i) <> Range("E" & m) Then
If Range("C" & j) <> Range("A" & j) & Range("C" & j) <> Range("B" & k) & Range("C" & j) <> Range("D" & l) & Range("C" & j) <> Range("E" & m) Then
If Range("C" & k) <> Range("A" & j) & Range("C" & k) <> Range("B" & k) & Range("C" & k) <> Range("D" & l) & Range("C" & k) <> Range("E" & m) Then
If Range("C" & l) <> Range("A" & j) & Range("C" & l) <> Range("B" & k) & Range("C" & l) <> Range("D" & l) & Range("C" & l) <> Range("E" & m) Then
If Range("C" & m) <> Range("A" & j) & Range("C" & m) <> Range("B" & k) & Range("C" & m) <> Range("D" & l) & Range("C" & m) <> Range("E" & m) Then
If Range("D" & i) <> Range("A" & j) & Range("D" & i) <> Range("B" & k) & Range("D" & i) <> Range("C" & l) & Range("D" & i) <> Range("E" & m) Then
If Range("D" & j) <> Range("A" & j) & Range("D" & j) <> Range("B" & k) & Range("D" & j) <> Range("C" & l) & Range("D" & j) <> Range("E" & m) Then
If Range("D" & k) <> Range("A" & j) & Range("D" & k) <> Range("B" & k) & Range("D" & k) <> Range("C" & l) & Range("D" & k) <> Range("E" & m) Then
If Range("D" & l) <> Range("A" & j) & Range("D" & l) <> Range("B" & k) & Range("D" & l) <> Range("C" & l) & Range("D" & l) <> Range("E" & m) Then
If Range("D" & m) <> Range("A" & j) & Range("D" & m) <> Range("B" & k) & Range("D" & m) <> Range("C" & l) & Range("D" & m) <> Range("E" & m) Then
If Range("E" & i) <> Range("A" & j) & Range("E" & i) <> Range("B" & k) & Range("E" & i) <> Range("C" & l) & Range("E" & i) <> Range("D" & m) Then
If Range("E" & j) <> Range("A" & j) & Range("E" & j) <> Range("B" & k) & Range("E" & j) <> Range("C" & l) & Range("E" & j) <> Range("D" & m) Then
If Range("E" & k) <> Range("A" & j) & Range("E" & k) <> Range("B" & k) & Range("E" & k) <> Range("C" & l) & Range("E" & k) <> Range("D" & m) Then
If Range("E" & l) <> Range("A" & j) & Range("E" & l) <> Range("B" & k) & Range("E" & l) <> Range("C" & l) & Range("E" & l) <> Range("D" & m) Then
If Range("E" & m) <> Range("A" & j) & Range("E" & m) <> Range("B" & k) & Range("E" & m) <> Range("C" & l) & Range("E" & m) <> Range("D" & m) Then
Range("G" & Aux) = Range("A" & i) & Range("B" & j) & Range("C" & k) & Range("D" & l) & Range("E" & m)
Aux = Aux + 1

End If
Next m
Next l
Next k
Next j
Next i

[/PHP]

Link to comment
Share on other sites

Solo has de hacer una combo por columna.

Dame un ratito y modifico este post con el If que habrías de poner.

Ok, ya ta...

¿Alguien sabe porque no funciona el condicional?

Sub Combinar()
Application.Calculation = xlCalculationManual
Range("G2:G60000").Select
Selection.ClearContents
Range("G1").Select
Dim a As String, b As String, c As String, d As String, e As String
Dim i As Integer, j As Integer, k As Integer, l As Integer, m As Integer, UltFilA As Integer, UltFilB As Integer, UltFilC As Integer, UltFilD As Integer, UltFilE As Integer, Aux As Integer
Aux = 2
UltFilA = Range("A65536").End(xlUp).Row
UltFilB = Range("B65536").End(xlUp).Row
UltFilC = Range("C65536").End(xlUp).Row
UltFilD = Range("D65536").End(xlUp).Row
UltFilE = Range("E65536").End(xlUp).Row
For i = 1 To UltFilA
For j = 1 To UltFilB
For k = 1 To UltFilC
For l = 1 To UltFilD
For m = 1 To UltFilE

'Aquí pongo las variables para no escribir tanto.
a = Range("A" & i)
b = Range("B" & j)
c = Range("C" & k)
d = Range("D" & l)
e = Range("E" & m)

'Este es el condicional, pero no funciona... Los strings son puñeteros. No entiendo bien el problema.
If ((a <> & (a <> c) & (a <> d) & (a <> e) & _
(b <> c) & (b <> d) & (b <> e) & _
(c <> d) & (c <> e)) Then

'He probado esta alternativa, pero tampoco funciona...
'If ((StrComp(a, b, 1) = StrComp(a, c, 1) = StrComp(a, d, 1) = StrComp(a, e, 1) = _
'StrComp(b, c, 1) = StrComp(b, d, 1) = StrComp(b, e, 1) & _
'StrComp(c, d, 1) = StrComp(c, e, 1)) <> 0) Then
Range("G" & Aux) = Range("A" & i) & Range("B" & j) & Range("C" & k) & Range("D" & l) & Range("E" & m)
Aux = Aux + 1
End If
Next m
Next l
Next k
Next j
Next i
Application.Calculation = xlCalculationAutomatic
End Sub[/PHP]

Link to comment
Share on other sites

Saludos nightz y michico

Aquí les dejo una Macro sacada de este Foro que quizás les pudiera ayudar a resolver el problema, en lo personal de Macros no sé nada, igual ni se acerca con lo que ustedes pretenden hacer o quizás modificándola un poco puedan solucionar el Tema, está pensada para Combinaciones Numéricas, pero entre las tantas pruebas que le realizado para tratar de adaptarla a mis necesidades también sirve para Texto.

Saludos

Lázaro

Sub GneraCombinacionesII()

Dim V(60), x, y, z

Application.DisplayStatusBar = True
Application.StatusBar = ""

For x = 1 To 60: V(x) = "": Next x

Range("B18:t65019").ClearContents

'Guardamos los números en un array
z = 1
For y = 10 To 20 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 60
For y = x + 1 To 60
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("b20:B743").ClearContents
Application.ScreenUpdating = False

x = 18
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 60
If reales > 393000 Then
MsgBox "Solo se han generado las primeras 393.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 1
If y = 0 Then y = 1
ActiveSheet.Cells(x, y * 2) = V(a) & " " & V( & " " & V(c) & " " & V(d) & " " & V(e) & " " & V(f)
If y = 1 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]

Link to comment
Share on other sites

Ya está. Creo que con esto solucionas el tema.

'Application.Calculation = xlCalculationManual
Range("G2:G60000").Select
Selection.ClearContents
Range("G1").Select
Dim i As Integer, j As Integer, k As Integer, l As Integer, m As Integer, UltFilA As Integer, UltFilB As Integer, UltFilC As Integer, UltFilD As Integer, UltFilE As Integer, Aux As Integer
Aux = 2
UltFilA = Range("A65536").End(xlUp).Row
UltFilB = Range("B65536").End(xlUp).Row
UltFilC = Range("C65536").End(xlUp).Row
UltFilD = Range("D65536").End(xlUp).Row
UltFilE = Range("E65536").End(xlUp).Row
For i = 1 To UltFilA
For j = 1 To UltFilB
For k = 1 To UltFilC
For l = 1 To UltFilD
For m = 1 To UltFilE

'inicializacion variables.
a = Range("A" & i)
b = Range("B" & j)
c = Range("C" & k)
d = Range("D" & l)
e = Range("E" & m)

'Filtro si son diferentes los valores cogidos de cada columna escribe sino no.
If (a <> And (a <> c) And (a <> d) And (a <> e) And _
(b <> c) And (b <> d) And (b <> e) And _
(c <> d) And (c <> e) And _
(d <> e) Then
Range("G" & Aux) = Range("A" & i) & Range("B" & j) & Range("C" & k) & Range("D" & l) & Range("E" & m)
Aux = Aux + 1
End If
Next m
Next l
Next k
Next j
Next i
'Application.Calculation = xlCalculationAutomatic[/PHP]

Cuidado no he declarado a,b,c,d,e, así que si usas Option Explicit posiblemente te diga warning.

Para declarar variables ya sabes Dim <nombre> As <tipo>

Link to comment
Share on other sites

  • 4 years later...

Claro que hasta este momento este tema quiza ya haya perdido vigencia pero por si lo  leen creo que esto es un calculo de arreglos factoriales 2 x 2 o de 2 x 3 etc, esto crearia una tabla que permite hacer los ensayos que convengan o todos y cada uno genera sus propios resultados diferentes

Link to comment
Share on other sites

  • Silvia locked this topic

Archived

This topic is now archived and is closed to further replies.

Guest
This topic is now closed to further replies.
  • Crear macros Excel

  • Posts

    • Pues tienes toda la razón.  Mucho más simplificado. ¡GRACIAS!
    • Que tal, verificando la consulta no veo necesidad de duplicar la Tabla de Reparto, dado que se puede simplemente agregar una columna (Importe total) con la siguiente fórmulación: =SUMAR.SI(Consumos!AR$2:AR$8;[@[Nombre completo]];Consumos!AK$2:AK$8)*[@[%]] Espero les sea útil.
    • Hola de nuevo por aquí. Sigo con el fichero de consumos y con problemas. Ayer me ayudasteis y mucho a determinar los conductores y sus consumos. Ahora lo que necesito es lo siguiente. Tengo una tabla donde los empleados imputan de manera porcentual a distintas ordenes de trabajo. Está en la hoja Reparto. Veréis que por ejemplo el primer empleado reparte un 50 a una OT y otro 50 a otra. El segundo empleado imputa un 40 a una OT y otro 60 a otra y el tercero imputa un 25 a una OT, un 65 a otra y un 10 a otra. Esto desglosarlo es un autentico lío, y cada mes me emplea muchísimo tiempo . Lo que quisiera es que en la hoja que le he llamado desglose me creara una tabla o en la que he hecho y me calculara el consumo de combustible de cada empleado teniendo en cuenta la OT y su porcentaje. He creado la tabla y he puesto los importes que deberían salir. Los importes de cada consumo están en la hoja Consumos en la columna AK (IMP_TOTAL). Por ejemplo en la hoja Desglose el primer empleado sería GARCIA FERNANDEZ, VICENTE y a la OT 11000001 tendría un importe de 28,70 euros ya que en la hoja Reparto decimos que imputa un 50 a esa OT y el consumo total de ese empleado de la hoja Consumo es de 57,40 euros. Y así con el resto. He puesto una tabla para que sea dinámico y si hay más consumos o empleados se vaya actualizando dinámicamente, o eso creo. Lo que no veo claro es que busque y autorrellene con formulas la tabla sin hacerlo con macros. Al menos para mi se me hace muy difícil ver la posibilidad. No tengo claro si he conseguido explicarme, cualquier duda os respondo. Y como siempre muy agradecido por vuestro tiempo y compartir tan hábiles conocimientos, y además de manera desinteresada y amable. Gracias.   Ejemplo consumos combustible sq.xlsx
    • Hola, yo también tengo el mismo problema, ¿podrías decir cómo lo solucionaste, por favor? :c
    • Hola Oscar, funciona perfectamente. He probado igual que con Silvia e independientemente del orden o incluso mezclando fechas funciona bien.   Gracias.  
  • Recently Browsing

    • No registered users viewing this page.
×
×
  • Create New...

Important Information

Privacy Policy