Saludos grupo, el presente es para solicitar ayuda con respecto a lo
siguiente:
Tenemos una lista con facturas de clientes por cancelar y deseamos saber
cuales facturas han sido cancelas, el problema esta en que el banco nos
suministra un monto xxxx (total), pero no da la información de cuáles
fueron las facturas fueron canceladas, por ejemplo el banco nos suministra
el siguiente monto 5.589.127,50 o cualquier otro monto y no sabemos cuantas
facturas corresponden a ese pago; el monto anterior corresponde a las dos
facturas marcadas en rojo (3061 y 3081) Estoy empezando a aprender VBA y
leyendo aquí y allá pude realizar una sub que creí me podía ayudar,
lamentablemente solo trabaja para encontrar un máximo de 4 facturas ya que
cuando hago una prueba con un monto para cinco facturas, el programa a veces
se cuelga y cuando ingreso un monto de prueba equivocado se tarda mas de 15
minutos o se queda colgado. la ayuda que solicito es: ¿cómo puedo hacer un
programa eficiente que automatice la búsqueda de dichas facturas?, ya que
las mismas pueden llegar hasta 12 por monto cancelado.
FACTURA BASE IMPONIBLE I.V.A. TOTAL RET. 2% RET.75% IVA TOTAL A
PAGAR
2602 967.500,00 145.125,00 1.112.625,00 19.350,00
108.843,75 984.431,25
2917 675.000,00 101.250,00 776.250,00 13.500,00 75.937,50 686.812,50
3005 1.545.000,00 231.750,00 1.776.750,00 30.900,00 173.812,50
1.572.037,50
3007 8.800.000,00 1.320.000,00 10.120.000,00 176.000,00 990.000,00
8.954.000,00
3061 1.518.000,00 227.700,00 1.745.700,00 30.360,00 170.775,00
1.544.565,00
3007 18.800.000,00 2.820.000,00 21.620.000,00 376.000,00 2.115.000,00
19.129.000,00
3073 1.975.000,00 296.250,00 2.271.250,00 39.500,00 222.187,50
2.009.562,50
3075 967.504,00 145.125,60 1.112.629,60 19.350,08 108.844,20
984.435,32
3074 22.000.000,00 3.300.000,00 25.300.000,00 440.000,00 2.475.000,00
22.385.000,00
3075 997.504,00 149.625,60 1.147.129,60 19.950,08
112.219,20 1.014.960,32
3076 875.000,00 131.250,00 1.006.250,00 17.500,00 98.437,50 890.312,50
3077 1.545.500,00 231.825,00 1.777.325,00 30.910,00 173.868,75
1.572.546,25
3078 9.800.000,00 1.470.000,00 11.270.000,00 196.000,00 1.102.500,00
9.971.500,00
3079 1.618.000,00 242.700,00 1.860.700,00 32.360,00 182.025,00
1.646.315,00
3080 35.000.000,00 5.250.000,00 40.250.000,00 700.000,00 3.937.500,00
35.612.500,00
3081 3.975.000,00 596.250,00 4.571.250,00 79.500,00 447.187,50
4.044.562,50
3082 27.560.000,00 4.134.000,00 31.694.000,00 551.200,00 3.100.500,00
28.042.300,00
Aquí le muestro el código que hice.
Sub Buscar_pagos()
'
'Sub para buscar facturas canceladas por clientes
'el banco da un monto xxxx (total), pero no da la información de cuales
fueron las facturas _
fueron canceladas por lo que esta Sub trata de averiguar cuales fueron las
facturas cancelas _
partiendo del monto total que da el banco.
Dim Bal As Integer: Dim valor1 As Double
Dim f1 As Double: Dim f2 As Double: Dim f3 As Double: Dim f4 As Double
Dim f5 As Double
If Range("h20") = "" Then ' verifico si hay un monto en la celda
MsgBox ("Introduzca un monto")
Exit Sub
Else
End If
valor1 = Range("h20").Value2 ' tomo el monto ingresado para luego comparar
con las celdas de la lista
Range("a1").Select
Set r = Range("a2:a50") ' calculo el número de filas de la lista
For n = 1 To r.Rows.Count
If r.Cells(n, 1) = "" Then
Exit For
End If
Next n
Range("g2:g" & n).Select
Selection.Font.ColorIndex = 0 ' color por defecto de las fuentes
Set r2 = Range("g2:g" & n)
Application.ScreenUpdating = False
For n = 1 To r2.Rows.Count
DoEvents
For a = 1 To r2.Rows.Count
For b = 1 To r2.Rows.Count
For c = 1 To r2.Rows.Count
For d = 1 To r2.Rows.Count
f2 = r2.Cells(d, 1).Value2 + r2.Cells(c, 1).Value2
f3 = r2.Cells(d, 1).Value2 + r2.Cells(c, 1).Value2 + r2.Cells(b, 1).Value2
f4 = r2.Cells(d, 1).Value2 + r2.Cells(c, 1).Value2 + r2.Cells(b, 1).Value2 +
_
r2.Cells(a, 1).Value2
f5 = r2.Cells(d, 1).Value2 + r2.Cells(c, 1).Value2 + r2.Cells(b, 1).Value2 +
_
r2.Cells(a, 1).Value2 + r2.Cells(n, 1).Value2
If f1 = valor1 Then
r2.Cells(d, 1).Select
Selection.Font.ColorIndex = 3 'coloreo fuente en rojo
del monto factura encontrada
Bal = 1
Exit For
ElseIf f2 = valor1 Then
r2.Cells(d, 1).Select
Selection.Font.ColorIndex = 3 ' factura1
r2.Cells(c, 1).Select
Selection.Font.ColorIndex = 3 'factura2
Bal = 1
Exit For
ElseIf f3 = valor1 Then
r2.Cells(d, 1).Select
Selection.Font.ColorIndex = 3 ' factura1
r2.Cells(c, 1).Select
Selection.Font.ColorIndex = 3 'factura2
r2.Cells(b, 1).Select
Selection.Font.ColorIndex = 3 'factura3
Bal = 1
Exit For
ElseIf f4 = valor1 Then
r2.Cells(d, 1).Select
Selection.Font.ColorIndex = 3 'factura1
r2.Cells(c, 1).Select
Selection.Font.ColorIndex = 3 '2
r2.Cells(b, 1).Select
Selection.Font.ColorIndex = 3 '3
r2.Cells(a, 1).Select
Selection.Font.ColorIndex = 3 '4
Bal = 1
Exit For
ElseIf f5 = valor1 Then
r2.Cells(d, 1).Select
Selection.Font.ColorIndex = 3 'factura1
r2.Cells(c, 1).Select
Selection.Font.ColorIndex = 3 '2
r2.Cells(b, 1).Select
Selection.Font.ColorIndex = 3 '3
r2.Cells(a, 1).Select
Selection.Font.ColorIndex = 3 '4
r2.Cells(n, 1).Select
Selection.Font.ColorIndex = 3 '5
Bal = 1
Exit For
Else
If n = r2.Rows.Count And a = r2.Rows.Count And b =
r2.Rows.Count _
And c = r2.Rows.Count Then
MsgBox ("facturas no encontradas, introduzca otro pago")
Exit Sub
End If
End If
If Bal = 1 Then Exit Sub ' si encontró las facturas salir de
la sub rutina
Next d
Next c
Next b
Next a
Next n
End Sub
Leer las respuestas