Confeccionar una subrutina en vba de excel
En cierta ocasión, los señores de Microsoft, me hicieron una macro, por la cual yo podía averiguar, que importes eran los que daban un numero dado. Me explico, yo tengo 13 facturas, con los importes siguientes: 146,05€; 447,72€; 84,89€; 286,41€; 332,99€; 563,61€; 65,50€; 79,16€; 363,18€; 515,55€; 420,15€; 84,89€ y 187,67€, todas ellas del mismo cliente, y dicho cliente me hace una transferencia por 1.772,74€, pero no me dice que facturas son las que paga. Pues bien en aquella subrutina que me hizo microsoft, y que después perdí, podía poner hasta 31 cifra, por que en aquellos tiempos los microprocesadores no daba para más. Alguno de los experto podría hacerme una rutina, ¿o explicarme como la podría hacer yo?.
Le quedo muy agradecido a quien pueda contestarme
Raúl Muñoz
2 respuestas
En http://programarexcel.com tienes cientos de ejemplos de macros para descargar que te pueden ayudar a realizar la macro, en https://www.youtube.com/channel/UCTKYXi9ljxxOAXXKgwWDDpQ encontrás videos con explicación.
Necesitas hacer bucles para realizar la macro que necesitas, ahí tienes ejemplos con bucles que recorren celdas para hacer lo que requieres.
. 07.03.17 #VBA Encontrar sumandos. Conciliación de valores
Buenas noches, Raúl
He dedicado algún tiempo a tu pregunta porque me ha parecido un desafío más que interesante.
Desde luego verás que la otra solución no te llevaría a ningún lado.
Ten presente que a medida que agregues números para cotejar la rutina demorará más tiempo en ejecutarse. El primer bucle que te mencionaron (y lleva varios) deberá revisar tantos ciclos como la resultante de 2 elevado a la cantidad de números que coloques para sumar. En tu ejemplo, de 13 valores, la rutina deberá armar 8.191 combinaciones y compararlas con tu número a buscar.
En mi equipo le llevó 20 segundos hacerlo, aunque no encontró ninguna combinación que diera exactamente 1.772,74, como planteaste en tu ejemplo. Sí lo hizo con otras sumas. Tal vez no sea esa la cifra a buscar, pero funciona correctamente. En caso de no encontrarla, también te avisa de ello.
Entiendo que no debe haber un límite de valores pero ten en cuenta el tiempo que insumirá procesarlo. De todos modos, aunque tarde, siempre será más veloz que intentar armarlo a mano.
Antes de ejecutar la rutina que comparto, arma tu planilla como en este ejemplo:
Luego, accede al Editor de VBA (Atajo: Alt + F11), allí inserta un módulo (Insertar-Módulo) y pega el siguiente código:
Option Base 1
Public NumBin
Sub BuscaSum()
Dim TablaVal()
'---- Variables modificables ----
'=== RAUL, modifica estos datos de acuerdo a tu proyecto:
aBuscar = "B5" ' Celda donde se indica el total a buscar
iniTabla = "B8" ' Celda donde inician los valores a considerar
PrimCelda = "D8" ' Celda donde empezará a dejar los resultados obtenidos (if any)
'---- fin Variables
'
'---- inicio de rutina:
'
Range(PrimCelda, ActiveSheet. Range(Left(PrimCelda, 1) & Rows. Count).End(xlUp). Address). ClearContents
Application.ScreenUpdating = False
IniTime = Now
LaFila = 0
cont = 0
aBuscar = Range(aBuscar).Value
'Loop de coleccion de valores a consderar y direcciones de celda
'una matriz multidemensional donde el primer elemento es el valor y
'el segundo es la dirección de la celda donde se encuentra
With Range(iniTabla)
Do While Not IsEmpty(.Offset(LaFila))
ReDim Preserve TablaVal(2, 1 + LaFila)
ElValor = .Offset(LaFila).Value
LaDire = .Offset(LaFila).Address(False, False)
TablaVal(1, 1 + LaFila) = ElValor
TablaVal(2, 1 + LaFila) = LaDire
LaFila = LaFila + 1
Loop
End With
CantComb = 2 ^ LaFila - 1
For Valo = 1 To CantComb
LaSuma = 0
Argumen = 0
'NumBin = Application.WorksheetFunction.Dec2Bin(Valo)
Deci2Bina (Valo)
NumBin = String(LaFila - Len(NumBin), "0") & NumBin
For Posi = 1 To LaFila
LaSuma = TablaVal(1, Posi) * Mid(NumBin, Posi, 1) + LaSuma
If Val(Mid(NumBin, Posi, 1)) = 1 Then
If Len(Argumen) > 1 Then
Argumen = Argumen & Application.International(xlListSeparator) & TablaVal(2, Posi)
Else
Argumen = TablaVal(2, Posi)
End If
End If
Next
If LaSuma = aBuscar Then
Range(PrimCelda).Offset(cont).FormulaLocal = "=suma(" & Argumen & ")"
Application.ScreenUpdating = True
Application.ScreenUpdating = False
cont = cont + 1
End If
Next
FinTime = Now - IniTime
FinTime = Format(FinTime, "hh:mm:ss")
ElMensaje = IIf(cont = 0, "NO SE ENCONTRO COMBINACION ALGUNA para " & Chr(10) & "el valor " & aBuscar, "Se encontraron: " & cont & " combinaci" & IIf(cont > 1, "ones", "ón") & Chr(10) & "para armar el valor " & aBuscar & Chr(10) & "en un tiempo de " & FinTime & " (hh:mm:ss)") ' & Chr(10) & Chr(10) & "(Ratio: " & RatioC & " registros por segundo)")
TipoMens = IIf(cont = 0, vbCritical, vbInformation)
ElTitulo = IIf(cont = 0, "NO ENCONTRO RESULTADO COINCIDENTE", "TERMINADO!")
Application.ScreenUpdating = True
MsgBox ElMensaje, TipoMens, ElTitulo
End Sub
Private Sub Deci2Bina(ByVal Valo As Long)
NumBin = ""
Numero = Valo
Do
Residuo = Numero Mod 2
NumBin = NumBin & Trim(Str(Residuo))
Numero = Int(Numero / 2)
Loop Until Numero < 2
If (Numero = 1) Then
NumBin = "1" & StrReverse(NumBin)
Else
NumBin = StrReverse(NumBin)
End If
End SubNota que, al principio del código, hay unas variables que corresponden a las celdas marcadas en verde en la imagen. Al ser variables, puedes modificarlas para adaptar el modelo a tu archivo.
Desde luego, los valores a considerar deben ser únicamente del cliente en cuestión.
El resultado será una lista de fórmulas de suma que logran el total buscado. Editando la fórmula verás qué celdas consideró en cada caso.
Bien, Raúl, espero que te sirva y que sea lo que buscabas.
Pd: con esto postergo por unos meses al Alzheimer... Je!
.
.
Buenas, Raúl
En virtud de la expectativa que me generó tu pregunta, me interesa saber si pudiste probar la solución y si te resolvió el problema.
Sólo eso.
Muy buen fin de semana.
Fer
.
.
Hola, Raúl
¿Será qué no tuviste oportunidad de probarla o no llegaste a ver mi respuesta?
Espero -curioso- tus comentarios.
Abrazo
Fer
.
.
Hola, Raúl
Mantengo el interés por saber si pudiste probar este desarrollo especial.
Saludos
Fer
.