Encontrar un numero multiplicando 3 números

. 15.02.17 #VBA Hallar factores de un producto

Buenos días, Jhonatan

Se puede resolver con una rutina primitiva que probará todos los productos posibles hasta encontrar el que le indiques que busque.

Desde luego, cuanto mayor sea el valor buscado, mayor serán las combinaciones que deberá probar el procedimiento y, en consecuencia, mayor el tiempo de procesamiento.

Prepara primero tu planilla, para que reciba los resultados positivos:

En la celda E2, por ejemplo coloca el número a buscar.

En la celdas G1, H1 y I1 coloca "Largo", "Ancho" y "Alto" respectivamente.

Accede al Editor de VBA (Atajo: Alt + F11), allí inserta un módulo (Insertar-Módulo) y pega el siguiente código:

Sub Factores()
'---- Variables modificables:
'=== JHONATAN Modificar estos datos de acuerdo al archivo actual:
Celdato = "E2" 'donde se coloca el número a factorear
col = "G" ' primera Columna donde acumula los datos de Largo, Ancho, Alto. Al principio tendrá sólo el título
IniPart = "B4"
'---- fin Variables
'
'---- inicio de rutina:
'  
Ultfila = Range(col & Rows.Count).End(xlUp).Row
ElValor = Range(Celdato).Value
cont = 0
If ElValor = 0 Then
    ElMensaje = "NO HAY VALOR EN LA CELDA " & Celdato & Chr(10) & "La rutina termina aquí"
    TipoMens = vbCritical
    ElTitulo = "FALTA DATO"
    MsgBox ElMensaje, TipoMens, ElTitulo
    Exit Sub
End If
IniTime = Now
For Largo = 1 To ElValor
    For Ancho = 1 To ElValor
        For Alto = 1 To ElValor
        If Largo * Ancho * Alto = ElValor Then
            With Range(col & Ultfila + 1)
                .Offset(0, 0).Value = Largo
                .Offset(0, 1).Value = Ancho
                .Offset(0, 2).Value = Alto
            End With
        Ultfila = Ultfila + 1
        cont = cont + 1
        End If
        Next
    Next
Next
    FinTime = Now - IniTime
    FinTime = Format(FinTime, "hh:mm:ss")
ElMensaje = IIf(cont = 0, "Ninguna combinación encontrada", "Se encontraron: " & cont & " combinaciones de factores") & " para el valor: " & ElValor & Chr(10) & "en un tiempo de " & FinTime & " (hh:mm:ss)" & Chr(10) & "desde: " & Format(IniTime, "hh:mm:ss") & Chr(10) & "hasta: " & Format(Now, "hh:mm:ss")
TipoMens = IIf(cont = 0, vbCritical, vbInformation)
ElTitulo = IIf(cont = 0, "SIN RESULTADOS", "TERMINADO!")
Application.ScreenUpdating = True
MsgBox ElMensaje, TipoMens, ElTitulo
End Sub

Notarás que al principio del código puedes cambiar la dirección de la celda donde colocas el número y la columna donde inician los títulos de "Largo", "Ancho" y "Alto"

Luego de ejecutarla, obtendrás un resultado como este:

Esta encontró 54 resultados posibles.

Si quieres probarla primero, coloca un número menor para probar.

.

Buenas tardes Fernando esto esta maravillosamente perfecto, solo tengo una pregunta como podríamos hacer para calcular decimales también, es esto posible?

.

Hola, Jhonatan

El problema es que amplía enormemente la cantidad de pruebas que la rutina tendría que hacer.

Trabajando con enteros sabes que el mayor factor que podrías tener es el número que estás buscando. En tu ejemplo 1780, toda vez que haciendo 1780 x 1 x1 obtienes ese valor.

Cualquier número superior daría un resultado mayor y, por tanto, no correspondería.

Al introducir los decimales, dos por ejemplo, la cantidad de combinaciones por cada dimensión se extenderían a 17,800,000 (x 3) lo que te secaría el procesador. A menos que te consigas la Deep Blue...

En definitiva, yo usaría la rutina anterior, colocando el número sin el separador decimal que uses y luego dividiría todos los resultados por las posiciones decimales que quitaste.

Aun así, la siguiente rutina te permite considerar decimales (que le indicarás en alguna celda -F2 en mi ejemplo). Si colocas 0 en esa celda, tendrás los resultados como la primera.

De todos modos como agrega una función de redondeo será más lenta que la anterior. Además le coloqué que le dé formato a las celdas de resultados con las posiciones decimales indicadas:

Sub FactoreAR()
'---- Variables modificables:
'=== Modificar estos datos de acuerdo al archivo actual:
Celdato = "E2" 'donde se coloca el número a factorear
Decimales = "F2" 'celda donde le indicas los decimales a considerar
col = "G" ' primera Columna donde acumula los datos de Largo, Ancho, Alto. Al principio tendrá sólo el título
IniPart = "B4"
'---- fin Variables
'
'---- inicio de rutina:
'  
Ultfila = Range(col & Rows.Count).End(xlUp).Row
ElValor = Range(Celdato).Value
Decimales = Range(Decimales).Value
Dec = Application.WorksheetFunction.Power(10, Decimales)
Formato = "#" & Application.DecimalSeparator & String(Decimales, "0")
cont = 0
If ElValor = 0 Then
    ElMensaje = "NO HAY VALOR EN LA CELDA " & Celdato & Chr(10) & "La rutina termina aquí"
    TipoMens = vbCritical
    ElTitulo = "FALTA DATO"
    MsgBox ElMensaje, TipoMens, ElTitulo
    Exit Sub
End If
IniTime = Now
For Largo = Round(1 / Dec, Decimales) To ElValor Step Round(1 / Dec, Decimales)
    Largo = Round(Largo, Decimales)
    For Ancho = Round(1 / Dec, Decimales) To ElValor Step Round(1 / Dec, Decimales)
        Ancho = Round(Ancho, Decimales)
        For Alto = Round(1 / Dec, Decimales) To ElValor Step Round(1 / Dec, Decimales)
            Alto = Round(Alto, Decimales)
            If Largo * Ancho * Alto = ElValor Then
                With Range(col & Ultfila + 1)
                    .Offset(0, 0).Value = Format(Largo, Formato)
                    .Offset(0, 1).Value = Format(Ancho, Formato)
                    .Offset(0, 2).Value = Format(Alto, Formato)
                End With
            Ultfila = Ultfila + 1
            cont = cont + 1
            End If
        Next
    Next
Next
    FinTime = Now - IniTime
    FinTime = Format(FinTime, "hh:mm:ss")
Application.ScreenUpdating = True
ElMensaje = IIf(cont = 0, "Ninguna combinación encontrada", "Se encontraron: " & cont & " combinaciones de factores") & " para el valor: " & ElValor & Chr(10) & "en un tiempo de " & FinTime & " (hh:mm:ss)" & Chr(10) & "desde: " & Format(IniTime, "hh:mm:ss") & Chr(10) & "hasta: " & Format(Now, "hh:mm:ss")
TipoMens = IIf(cont = 0, vbCritical, vbInformation)
ElTitulo = IIf(cont = 0, "SIN RESULTADOS", "TERMINADO!")
MsgBox ElMensaje, TipoMens, ElTitulo
End Sub

Prueba con ambas alternativas.

Un abrazo

Fer

.

Perfecto voy a probarlo y te cuento igual los decimales que usaría no son números superiores a 150 creería que puede ser trabajable  de todos modos lo voy a probar y te cuento, te parece? Gracias de nuevo