Buscar multiplicandos
Hola experto,
En este link:
http://www.todoexpertos.com/categorias/tecnologia-e-internet/software-y-aplicaciones/microsoft-excel/respuestas/2196094/buscar-en-rango-aquellas-celdas-que-sumen-valor-dado
Necesito por favor me ayudes con un macro que haga lo mismo, pero que Busque en rango aquellas celdas que MULTIPLICADAS den el valor dado.
Se que se manejan números muy grandes, pero la lista de números que se multiplicaran entre si para encontrar un valor es del 1 al 50 y en grupos de 6:
Por ejemplo:
1
2
3
4
5
6
7
8
(...)
50
Por ejemplo, tengo siguiente numero: (1*2*4*6*7*8) = 2688. En este caso kisiera que el macro encuentre la combinacion que me de como resultado dicho numero 2688.
Exactamente como en el ejemplo del link, donde el macro hace las interacciones, y escribe las combinaciones en una lista.
Muchísimas gracias de antemano.
En este link:
http://www.todoexpertos.com/categorias/tecnologia-e-internet/software-y-aplicaciones/microsoft-excel/respuestas/2196094/buscar-en-rango-aquellas-celdas-que-sumen-valor-dado
Necesito por favor me ayudes con un macro que haga lo mismo, pero que Busque en rango aquellas celdas que MULTIPLICADAS den el valor dado.
Se que se manejan números muy grandes, pero la lista de números que se multiplicaran entre si para encontrar un valor es del 1 al 50 y en grupos de 6:
Por ejemplo:
1
2
3
4
5
6
7
8
(...)
50
Por ejemplo, tengo siguiente numero: (1*2*4*6*7*8) = 2688. En este caso kisiera que el macro encuentre la combinacion que me de como resultado dicho numero 2688.
Exactamente como en el ejemplo del link, donde el macro hace las interacciones, y escribe las combinaciones en una lista.
Muchísimas gracias de antemano.
Respuesta de jrgces
1
Entiendo que el número de multiplicandos tiene que ser siempre 6, así que en este caso estaríamos hablando de combinar 50 elementos en grupos de 6, lo que genera 15.890.700 posibles combinaciones. Es un número grande, pero manejable para VBA:
Public Function BuscarMultiplicandos(dValorBuscado As Double) As String
Dim a As Double, b As Double, c As Double, d As Double, e As Double, f As Double
For a = 1 To 45
For b = a + 1 To 46
For c = b + 1 To 47
For d = c + 1 To 48
For e = d + 1 To 49
For f = e + 1 To 50
If a * b * c * d * e * f = dValorBuscado Then
BuscarMultiplicandos = "=" & CStr(a) & "*" & CStr(b) & "*" & CStr(c) & "*" & CStr(d) & "*" & CStr(e) & "*" & CStr(f)
Exit Function
End If
Next f
Next e
Next d
Next c
Next b
Next a
BuscarMultiplicandos = "No encontrados"
End Function
La sintaxis para llamar a la función es muy sencilla. Por ejemplo, para encontrar los multiplicandos de 2688 (en este caso, una de las posibles combinaciones que arrojan 2688), sería:
=BuscarMultiplicandos(2688)
que devuelve =1*2*3*4*7*16
Public Function BuscarMultiplicandos(dValorBuscado As Double) As String
Dim a As Double, b As Double, c As Double, d As Double, e As Double, f As Double
For a = 1 To 45
For b = a + 1 To 46
For c = b + 1 To 47
For d = c + 1 To 48
For e = d + 1 To 49
For f = e + 1 To 50
If a * b * c * d * e * f = dValorBuscado Then
BuscarMultiplicandos = "=" & CStr(a) & "*" & CStr(b) & "*" & CStr(c) & "*" & CStr(d) & "*" & CStr(e) & "*" & CStr(f)
Exit Function
End If
Next f
Next e
Next d
Next c
Next b
Next a
BuscarMultiplicandos = "No encontrados"
End Function
La sintaxis para llamar a la función es muy sencilla. Por ejemplo, para encontrar los multiplicandos de 2688 (en este caso, una de las posibles combinaciones que arrojan 2688), sería:
=BuscarMultiplicandos(2688)
que devuelve =1*2*3*4*7*16
Muchas gracias experto, esta muy bueno.
Quería que me aclararas lo siguiente:
¿Sola arroja una combinación?, ¿O es posible que arroje algunas otras?
¿Y si yo deseara que no fueran 50 numero sino 45 que debo hacer?
Por lo demás muchísimas gracias
Quería que me aclararas lo siguiente:
¿Sola arroja una combinación?, ¿O es posible que arroje algunas otras?
¿Y si yo deseara que no fueran 50 numero sino 45 que debo hacer?
Por lo demás muchísimas gracias
Para que aparezcan todas las combinaciones de multiplicandos para un entero dado hay que reconvertir la función a procedimiento para que se pueda situar cada combinación en una fila, porque hay enteros que producen bastantes combinaciones (por ejemplo, el 165765600 produce 170 combinaciones), cantidad de filas que en una sola celda resultaría inmanejable:
Public Sub BuscarMultiplicandos()
Dim a As Double, b As Double, c As Double, d As Double, e As Double, f As Double
Dim dValorBuscado As Double, iÚltimaFila As Integer, n As Byte
dValorBuscado = InputBox("Entero del que se desea conocer sus multiplicandos: ")
With Worksheets("Hoja1")
.Cells.Delete
For a = 1 To 40
For b = a + 1 To 41
For c = b + 1 To 42
For d = c + 1 To 43
For e = d + 1 To 44
For f = e + 1 To 45
If a * b * c * d * e * f = dValorBuscado Then
iÚltimaFila = iÚltimaFila + 1
.Cells(iÚltimaFila, 1).Value = a
.Cells(iÚltimaFila, 2).Value = b
.Cells(iÚltimaFila, 3).Value = c
.Cells(iÚltimaFila, 4).Value = d
.Cells(iÚltimaFila, 5).Value = e
.Cells(iÚltimaFila, 6).Value = f
End If
Next f
Next e
Next d
Next c
Next b
Next a
End With
End Sub
El código preguntará el entero a procesar y volcará los resultados en Hoja1, desde la fila 1 hasta donde sea necesario. Por lo tanto, en Hoja1 no puede haber nada (puesto que el código borrará todas las celdas de esa hoja durante su ejecución), y además hay que tener en cuenta que cada vez que se ejecute se borrarán los resultados anteriores, si los hay.
Public Sub BuscarMultiplicandos()
Dim a As Double, b As Double, c As Double, d As Double, e As Double, f As Double
Dim dValorBuscado As Double, iÚltimaFila As Integer, n As Byte
dValorBuscado = InputBox("Entero del que se desea conocer sus multiplicandos: ")
With Worksheets("Hoja1")
.Cells.Delete
For a = 1 To 40
For b = a + 1 To 41
For c = b + 1 To 42
For d = c + 1 To 43
For e = d + 1 To 44
For f = e + 1 To 45
If a * b * c * d * e * f = dValorBuscado Then
iÚltimaFila = iÚltimaFila + 1
.Cells(iÚltimaFila, 1).Value = a
.Cells(iÚltimaFila, 2).Value = b
.Cells(iÚltimaFila, 3).Value = c
.Cells(iÚltimaFila, 4).Value = d
.Cells(iÚltimaFila, 5).Value = e
.Cells(iÚltimaFila, 6).Value = f
End If
Next f
Next e
Next d
Next c
Next b
Next a
End With
End Sub
El código preguntará el entero a procesar y volcará los resultados en Hoja1, desde la fila 1 hasta donde sea necesario. Por lo tanto, en Hoja1 no puede haber nada (puesto que el código borrará todas las celdas de esa hoja durante su ejecución), y además hay que tener en cuenta que cada vez que se ejecute se borrarán los resultados anteriores, si los hay.
