Bucle para comparar dos tablas por un campo id y campo monto

En vba de access estoy intentando comparar los registros de dos tablas ( Banco y Sistema), la idea es que un bucle recorra el campo Doc de la tabla banco y evalúe el campo Doc y campo Monto de la tabla sistema, es decir, si en la tabla Sistema encuentra un Doc igual a la tabla banco y que además el campo Monto, sume lo mismo, actualice el campo Estado que existe en ambas tablas a "Conciliado", espero haberme explicado.

Adjunto lo que tengo:

Private Sub Command199_Click()
On Error GoTo ErrSub
Dim rst1 As DAO.Recordset
Dim rst2 As DAO.Recordset
Set rst1 = CurrentDb.OpenRecordset("Banco", dbOpenDynaset) 'dbOpenSnapshot
Set rst2 = CurrentDb.OpenRecordset("Sistema", dbOpenDynaset) 'dbOpenDynaset
Dim vcod1 As String
Dim vcod2 As String
Dim vobs As String
Dim sb As Double
Dim ss As Double
DoCmd.SetWarnings True
rst1.MoveFirst
rst2.MoveFirst
Do Until rst1.EOF Or rst2.EOF
vcod1 = rst1.Fields("Document").Value
vcod2 = rst2.Fields("External Doc").Value
vobs = "Conciliado"
sb = DSum("[Amount]", "[Banco]", "[Banco]![Document] =" & vcod1)
ss = DSum("[Amount]", "[Sistema]", "[Sistema]![External Doc]=" & vcod2)
If vcod1 = vcod2 And sb = ss Then
rst2.Edit
rst2.Fields("Estado").Value = vobs
rst2.Update
rst2.MoveNext
Else
rst1.MoveNext
End If
Loop
rst1.Close
Set rst1 = Nothing
rst2.Close
Set rst2 = Nothing
Exit Sub
'Mensaje Error
ErrSub:
MsgBox Err.Description, vbCritical
End Sub

1 Respuesta

Respuesta
1

Entiendo que quieres poner como conciliados los registros de 2 tablas que tienen el mismo 'doc' y 'monto'. Yo añadiría: que no estén conciliados anteriormente.

Yo usaría este código:

Sub conciliarBancoSistema()
Dim rsB As Recordset
Dim rsS As Recordset
Dim txtSql As String
' Leemos los registros de banco que no están conciliados
txtSql = "select * from banco where nz(estado,'')<>'Conciliado'"
Set rsB = CurrentDb().OpenRecordset(txtSql, dbOpenDynaset)
If Not rsB.EOF Then rsB.MoveLast: rsB.MoveFirst
SysCmd acSysCmdInitMeter, "Conciliando banco", rsB.RecordCount
Do While Not rsB.EOF
SysCmd acSysCmdUpdateMeter, rsB.AbsolutePosition + 1
DoEvents
' Buscamos el mismo doc y monto en sistema... y que no esté conciliado
txtSql = "select * from sistema " & _
"where [External Doc]='" & rsB!Document & "' and " & _
"monto=" & Str$(rsB!monto) & " and " & _
"nz(estado,'')<>'Conciliado'"
Set rsS = CurrentDb().OpenRecordset(txtSql)
If Not rsS.EOF Then
' Encontrado. Actualizamos los estados
rsB.Edit: rsB!estado = "Conciliado": rsB.Update
rsS.Edit: rsS!estado = "Conciliado": rsS.Update
End If
rsB.MoveNext
Loop
rsB.Close
SysCmd acSysCmdClearStatus
MsgBox "Conciliación terminada"
End Sub

Si son muchos registros, para que funcione más rápido es interesante tener creado un índice sobre los campos [External Doc]-[Monto] de la tabla sistema. Si son pocos registros no vale mucho la pena.

Hola estimado, muchísimas gracias por tu respuesta, es como lo entiendes, salvo por un detalle, que es que podrían haber mas de una linea con el mismo doc , por ejemplo en la tabla Sistema, que sumen lo mismo, que un solo doc de la tabla banco , como se podría hacer en ese caso?

Saludos.

El código concilia los movimientos uno a uno. Si hay 2 registros en bancos tendrá que haber 2 en sistema para que los concilie.

Si hubiera 2 en bancos y 1 en sistema, pondría 1 de bancos como conciliado y el otro no. Lógicamente en este ejemplo el de sistemas pasará a conciliado.

No sé si es así como lo quieres.

Estimado, disculpa por no ser tan claro, normalmente pasa aquí que yo tengo en sistema generados varios movimientos y el banco solo genera uno por el total, lo que yo quiero es llegar a ese nivel, que el bucle recorra la tabla banco si encuentra un doc igual filtre por el doc y sume,si la suma da el mismo monto me actualice el campo a Conciliado.

Sin problemas. El código sería de esta forma:

Sub conciliarBancoSistema()
Dim rsB As Recordset
Dim rsS As Recordset
Dim aux As Double
Dim txtSql As String
' Leemos los registros de banco que no están conciliados
txtSql = "select * from banco where nz(estado,'')<>'Conciliado'"
Set rsB = CurrentDb().OpenRecordset(txtSql, dbOpenDynaset)
If Not rsB.EOF Then rsB.MoveLast: rsB.MoveFirst
SysCmd acSysCmdInitMeter, "Conciliando banco", rsB.RecordCount
Do While Not rsB.EOF
SysCmd acSysCmdUpdateMeter, rsB.AbsolutePosition + 1
DoEvents
' Buscamos los registros de sistema que no están conciliados,
' del mismo documento, y sumamos el monto.
' Si la suma es la misma, marcaremos de sistema cada registro
' del documento y también el de banco
' Empezamos por sumar el importe. Para ello pondremos en la variable
' txtSql sólo la condición del documento y que no esté conciliado
txtSql = "[External Doc]='" & rsB!Document & "' and " & _
"nz(estado,'')<>'Conciliado'"
aux = DLookup("sum(monto)", "sistema", txtSql) ' Busca los docs y suma monto
If Abs(rsB!monto - aux) < 0.0001 Then
' El registro del banco suma lo mismo que los de sistema del mismo
' documento. Los conciliamos todos.
' Buscamos el mismo doc en sistema... y que no esté conciliado
txtSql = "select * from sistema " & _
"where [External Doc]='" & rsB!Document & "' and " & _
"nz(estado,'')<>'Conciliado'"
Set rsS = CurrentDb().OpenRecordset(txtSql)
If Not rsS.EOF Then rsS.MoveFirst
Do While Not rsS.EOF
rsS.Edit: rsS!estado = "Conciliado": rsS.Update
rsS.MoveNext
Loop
rsS.Close
rsB.Edit: rsB!estado = "Conciliado": rsB.Update
End If
rsB.MoveNext
Loop
rsB.Close
SysCmd acSysCmdClearStatus
MsgBox "Conciliación terminada"
End Sub

En este caso, en lugar de buscar un registro de sistema con el mismo monto lo que hacemos es sumar los montos de todos los registros de sistema con el mismo doc y, si coincide con el de banco, se marcan todos.

OJO: Para saber si los importes son iguales, en lugar de comparar si "rsb!monto=aux" (aux es la suma de montos de sistema), lo que hago es "If Abs(rsB!monto - aux) < 0.0001". Esto se debe a que a veces Windows tiene pequeños errores internos y en lugar de almacenar un valor guarda otro 'casi' idéntico (en lugar de 6 puede tener 5'99999...) que hace que las comparaciones no sean iguales.

Espero que esta vez sí haya acertado con lo que quieres.

hola estimado, lo voy a probar y te comento lo antes posible.

Saludos.

Ok.

Escríbeme cuando lo hayas visto.

No me contestes hasta que tengas alguna pregunta (o la cierres) pues me aparece como pendiente de respuesta y, si más adelante pones algún comentario, no me entero de la nueva pregunta.

Hola estimado, he estado probando este código, pero me está marcando un error, y el problema es que no se por qué no me manda al editor de código, como para saber cual línea tiene problemas, el error es invalid use of null,

Adjunto como lo dejé, saludos.

Private Sub Command187_Click()
On Error GoTo Err_Command187_Click
Dim rsB As Recordset
Dim rsS As Recordset
Dim aux As Double
Dim txtSql As String
' Leemos los registros de banco que no están conciliados
txtSql = "Select * from Banco where nz(Estado,'')<>'Conciliado'"
Set rsB = CurrentDb().OpenRecordset(txtSql, dbOpenDynaset)
If Not rsB.EOF Then rsB.MoveLast: rsB.MoveFirst
SysCmd acSysCmdInitMeter, "Conciliando Banco", rsB.RecordCount
Do While Not rsB.EOF
SysCmd acSysCmdUpdateMeter, rsB.AbsolutePosition + 1
DoEvents
' Buscamos los registros de sistema que no están conciliados,
' del mismo documento, y sumamos el monto.
' Si la suma es la misma, marcaremos de sistema cada registro
' del documento y también el de banco
' Empezamos por sumar el importe. Para ello pondremos en la variable
' txtSql sólo la condición del documento y que no esté conciliado
txtSql = "[External Doc]='" & rsB!Document & "' and " & _
"nz(Estado,'')<>'Conciliado'"
aux = DLookup("Sum(Amount)", "Sistema", txtSql) ' Busca los docs y suma monto
If Abs(rsB!Amount - aux) < 0.0001 Then
' El registro del banco suma lo mismo que los de sistema del mismo
' documento. Los conciliamos todos.
' Buscamos el mismo doc en sistema... y que no esté conciliado
txtSql = "Select * From Sistema " & _
"where [External Doc]='" & rsB!Document & "' and " & _
"nz(Estado,'')<>'Conciliado'"
Set rsS = CurrentDb().OpenRecordset(txtSql)
If Not rsS.EOF Then rsS.MoveFirst
Do While Not rsS.EOF
rsS.Edit: rsS!Estado = "Conciliado": rsS.Update
rsS.MoveNext
Loop
rsS.Close
rsB.Edit: rsB!Estado = "Conciliado": rsB.Update
End If
rsB.MoveNext
Loop
rsB.Close
SysCmd acSysCmdClearStatus
MsgBox "Conciliación terminada"
Exit_Command187_Click:
Exit Sub
Err_Command187_Click:
MsgBox Err.Description
Resume Exit_Command187_Click:
End Sub

Pues así... malo. No tengo dotes para adivinar la línea del error.

Si quieres sube la base de datos a un disco virtual (por ejemplo dropbox) y me mandas el enlace.

Hola estimado, gracias nuevamente, te lo he dejado en esta ruta : https://skydrive.live.com/?cid=96957cbf27fd83c0#cid=96957CBF27FD83C0&id=96957CBF27FD83C0%21105

Saludos y reitero mis agradecimientos.

Vayamos por partes:

1) La línea que está dando el error es:

Aux = DLookup("Sum(Amount)", "Sistema", txtSql) ' Busca los docs y suma monto

Sustitúyela por:

Aux = Nz(DLookup("Sum(Amount)", "Sistema", txtSql), 0) ' Busca los docs y suma monto

Con eso funciona. Continúo:

2) Como te interesa marcar los registros de dos tablas 'al mismo tiempo', deberías usar el concepto transacción. Una transacción es una serie de instrucciones que tienen que ejecutarse al mismo tiempo de forma que o se ejecutan todas o no se ejecuta ninguna.

Suponte que marcas los registros de "Sistema" y un fallo de luz corta el proceso y se queda sin actualizar "Bancos". El registro de esta última tabla quedaría sin marcar y nuestra base de datos tendría un error complicado de localizar.

¿Cómo hacemos que se ejecuten todas las actualizaciones o ninguna? Usando una transacción. La transacción empieza por "Begintrans" y termina con "Committrans". Pon esas dos instrucciones en la parte del código que te indico:

Workspaces(0). BeginTrans
Set rsS = CurrentDb().OpenRecordset(txtSql)
If Not rsS.EOF Then rsS.MoveFirst
Do While Not rsS.EOF
rsS.Edit: rsS!Estado = "Conciliado": rsS.Update
rsS.MoveNext
Loop
rsS.Close
rsB.Edit: rsB!Estado = "Conciliado": rsB.Update
Workspaces(0). CommitTrans

Poniendo esas dos instrucciones asegurarás el proceso.

Y terminando:

3) ¿Por qué pones siempre como primera instrucción un 'On Error GoTo ...'?

La instrucción On Error es muy práctica pero no se puede usar de forma indiscriminada. El problema que tenías se escondía por el uso de esa instrucción y sólo he podido encontrar la línea que daba el error cuando la que quitado.

Mi consejo es que quites esa instrucción en todos los sitios que la tienes puesta y pruebes a corregir los errores que se producen. La solución no es esconder los errores sino detectarlos y arreglarlos.

Bueno, no me enrollo más que creo que por hoy tienes para entretenerte.

Muchísimas gracias estimado, me quedó bastante claro y lo pude corregir y hacer funcionar.

Saludos y reitero mis agradecimientos.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas