Officefull.es

Excel, word, powerpoint, android

Localizar Varias Sumas mayo 23, 2009

Localizar Varias Sumas Excel

Excel Combinaciones Solver

Por ejemplo, si trabajamos con facturas, alguna vez hemos necesitado saber cuáles de esas facturas suman una determinada cantidad. En el artículo de hoy os mostraremos como podéis localizar esas sumas y exactamente que celdas suman esa determinada cantidad, utilizando Código Solver y Combinaciones.

Desarrollo

Pasos a realizar antes de Ejecutar el Código:

Agregar Referencia al complemento Solver.xla [Versiones anteriores a Office 2007 ] – Solver.xlam [Versión Office 2007 ]

1 Abrimos el Editor de Visual Basic Excel con la combinación de teclas [ Alt + F11 ]

En el editor de Visual Basic, nos vamos a menú Herramientas y click en Referencias.

Referencias Visual Basic

2 En el cuadro de diálogo que nos aparece, click en el botón Examinar.

Agregar Referencia proyecto

3 En el cuadro de diálogo Agregar Referencias, nos dirigimos hacia la siguiente ruta:

Para la Versión office 2007

Archivos de programa\Microsoft Office\Office 12\Libray\Solver\SOLVER.XLAM

Agregar referencia Solver

Para Versiones anteriores de Office

Archivos de programa\Microsoft Office\Office XX\Libray\Solver\SOLVER.XLA (donde XX pertenece a la Versión de office instalada)

Solver xla/m

Agregada la Referencia Solver

4 Observamos en el Proyecto – VBAProyect que se ha cargado el complemento [Solver.xla/m]

Código Localizar Varias sumas

Dentro del Módulo 1 observaremos el procedimiento:

Sub Localizar_Sumas(): Dim Intento As Long, Celda As Range, Sig As Integer, Opcion As String   Range([Opciones].Offset(1), [Opciones].Offset(1).End(xlDown)).ClearContents   [Sumandos].ClearContents: Application.ScreenUpdating = False   For Intento = 1 To [Posibles]     SolverReset     SolverOk SetCell:="" & [Prueba].Address & "", _                     MaxMinVal:=3, _                     ValueOf:="" & Intento & "", _                     ByChange:="" & [Sumandos].Address & ""     SolverAdd CellRef:="" & [Sumandos].Address & "", _                       Relation:=5, _                       FormulaText:="Binario"     SolverOptions Precision:=0.000001, _                             Convergence:=0.001     SolverOk SetCell:="" & [Prueba].Address & "", _                     MaxMinVal:=3, _                     ValueOf:="" & Intento & "", _                     ByChange:="" & [Sumandos].Address & ""     SolverSolve UserFinish:=True     If [Resultado] = [Objetivo] Then       For Each Celda In [Sumandos]         If Celda > 0 Then           If Opcion <> "" Then Opcion = Opcion & "+"           Opcion = Opcion & LCase(Celda.Offset(, -1).Address(False, False))         End If: Next: Sig = Sig + 1: [Opciones].Offset(Sig) = Sig & ") " & Opcion: Opcion = ""     End If: Next: [Opciones].EntireColumn.AutoFit: End Sub 

Si la Versión instalada de Office es en Inglés, buscaremos en el procedimiento [ Sub Localizar_Sumas() ]:

Binario y se reemplazará por Binary

Si la Versión de office es XP (2002), (2003) ó (2007), buscaremos y reemplazaremos lo siguiente en el código

SolverOk y lo reemplazaremos por SolvOk

Buscar y Reemplazar Código en el Editor de VB

Realizaremos el mismo proceso para:

SolverAdd por SolvAdd

5 Ahora sí podemos ejecutar el Código, para ello:

Cerramos Visual Basic y nos vamos a la interfaz de Excel, y presionamos la combinación de teclas [ALT+F8 ], en el cuadro de diálogo Macro, seleccionamos el procedimiento Localizar_Sumas y click enEjecutar, una vez terminado de realizar los cálculos observaremos lo siguiente:

Localizar Varias Sumas Excel

  • Columna ID

Identificadores por ejemplo de números de Factura.

  • Columna Valores

Reservada toda la columna exclusivamente solo para los Valores/importes los cuales van a ser sumados, SIN exceder el límite de Solver de 200 Celdas cambiantes [o… sumables].

TIP: No mayores a la cantidad Buscada 

  • Columna Combinar

Si se agrega/elimina números sumables en la columna Valores …[de]crece las fórmulas de esta columna. SIN EXCEDER el límite del Solver de 200 celdas cambiantes [o… sumables].

  • Celda Posibles

Cuenta las posibles combinaciones, considerando que las posibles combinaciones son: 2^n_sumables-1

Si se trata de muchos sumables, el proceso se volverá bastante lento.

  • Celda Prueba

Contador que monitorea las posibilidades.

  • Celda Objetivo

El valor final sumatoria que se busca.

  • Celda Resultado

Un paso temporal, compara resultados.

  • Celda Opciones

Aquí se escriben las combinaciones posibles cuya suma da [ 5 ] de los valores de la columna [Valores ].

6 Si se produce un error del tipo:Memoria agotada o error inesperado

En el editor de Visual Basic de Excel, presionamos la combinación de teclas [ Ctrl+G ] para abrir la ventana inmediato y ahí escribimos la siguiente instrucción y pulsaremos la tecla Enter:

Application.Run (“Solver.xlam!Auto_Open”) ó bien Application.Run (“Solver.xla!Auto_Open”)

Ventana Inmediato VBA

6Nombres dinámicos y Nombres estáticos utilizados:

Localizar Sumas

Código utilizado para los botones de Instrucciones Comentarios

Private Sub Instrucciones_Click()   With Me.Shapes("Instrucciones")     .Visible = (Instrucciones = -1)   End With: SendKeys "{Esc}" End Sub   Private Sub Comentarios_Click(): Dim Mostrar   If Comentarios = -1 Then Mostrar = xlCommentAndIndicator _   Else Mostrar = xlCommentIndicatorOnly   Application.DisplayCommentIndicator = Mostrar: SendKeys "{Esc}" End Sub 

Función Personalizada

La siguiente Función Personalizada obtiene la localización de una Suma solicitada en el rango donde se necesite buscar.

Los argumentos opcionales son:

Direccion => obtener la dirección de la/s celda/s o su/s valores

Ultima => obtener los valores que dan la suma de abajo-arriba o de arriba-abajo

=BuscarSumandos(A1,B18:B45,1,1)

Funcion personalizada localizar sumas

OJO: si existen dos (o más) “posibilidades”, SOLO DEVUELVE UNA ‘

' (basado en el codigo original de Jimmy L. Day: -> http://tinyurl.com/3qglnn) ' Private Objetivo As Double, Optimo As Double, Celdas As Integer, n As Integer, _ Prueba() As Integer, Confirma() As Integer, Compara As String, Valores   Function BuscarSumandos(Buscar As Double, Buscar_donde As Range, _ Optional Direccion As Boolean = False, _ Optional Ultima As Boolean = False) As String Dim Tmp As String Optimo = 0 Objetivo = Buscar Compara = IIf(Ultima, "<", "<=") With Buscar_donde.Columns(1) Celdas = .Rows.Count Valores = Application.Transpose(.Value) ReDim Prueba(Celdas) ReDim Confirma(Celdas) Evalua 0, 1 For n = 1 To Celdas If Confirma(n) Then Tmp = Tmp & "+" & IIf(Direccion, .Cells(n).Address(0, 0), .Cells(n)) Next End With If Tmp = "" Then BuscarSumandos = "Sumandos NO Localizados !!!" Exit Function End If BuscarSumandos = IIf(Evaluate(Tmp) <> Objetivo, "Aproximado: ", "") & "=" & Mid(Tmp, 2) End Function   Private Function Evalua(ByVal Suma As Double, ByVal Pos As Integer) If Pos <= Celdas Then Prueba(Pos) = 0 Evalua Suma, Pos + 1 Prueba(Pos) = 1 Evalua Suma + Valores(Pos), Pos + 1 Else Select Case Compara Case "<=" If (Abs(Suma - Objetivo) <= Abs(Objetivo - Optimo)) Then Optimo = Suma For n = 1 To Celdas Confirma(n) = Prueba(n) Next End If Case "<" If (Abs(Suma - Objetivo) < Abs(Objetivo - Optimo)) Then Optimo = Suma For n = 1 To Celdas Confirma(n) = Prueba(n) Next End If End Select End If End Function

Descarga del Archivo para pruebas

Localizar varias sumas (15.2 kB)

Enlaces de interés

Introducción a la optimización con la herramienta Solver de Excel

http://office.microsoft.com/es-es/excel/HA011245953082.aspx

Determinar la mezcla de productos óptima con Solver

http://office.microsoft.com/es-es/excel/HA011245963082.aspx

 

Categorías: Sin categoría

Deja un comentario

Tu dirección de correo electrónico no será publicada. Los campos obligatorios están marcados con *