Averiguar los números que faltan en una serie de Documentos
Dispongo de una tabla donde están guardados los Albaranes generados y necesito conocer los posibles números que puedan faltar en cada una de las series.
Estos están compuestos por series diferentes: GF01245 - JU00254.. Etc.
He de conocer los números inexistentes por cada una de las series y poderlos visualizar en un Formulario.
2 Respuestas
José, puedes hacerlo de muchas formas. Habría que saber la estructura de tus tablas. Por ejemplo, tengo la tabla Facturas a la que le he añadido un campo NumFin
Este campo va a coger, en este caso, el valor de las dos últimas cifras de Nfactura( podrían ser las tres, cuatro, etc).
Y tengo un formulario, que cuando lo abro le asigna valor al campo Numfin
Ahora voy a elegir una serie( el cuadro de texto a la derecha de Elija una serie se llama Faltan
Selecciono la BB y entonces me deja el formulario como
En Faltan me pone que no están la BB00002, etc.
En este caso en particular, ya te digo que habría que saber la estructura de tu tabla, el código del evento Al cargar del formulario es
Private Sub Form_Load() DoCmd.RunSQL "update facturas set Numfin=val(right([nfactura],2))" Me.Refresh End Sub
Y el código del evento Después de actualizar del combinado ElegirSerie es
Private Sub ElegirSerie_AfterUpdate()
Me.RecordSource = "select * from facturas where left([nfactura],2)='" & Me.ElegirSerie & "'"
Dim i As Integer, d As Byte, c As Byte
DoCmd.GoToRecord , , acFirst
For i = 1 To Me.Recordset.RecordCount
d = NumFin - (Nz(DMax("NumFin", "Facturas", "NumFin<" & Me.NumFin & " and left([nfactura],2)='" & Me.ElegirSerie & "'")) + 1)
If d = 1 Then
Faltan = Nz([Faltan], "") & "," & Left([NFactura], 2) & "" & Mid([NFactura], 3, 1) & "" & Format((Nz(DMax("NumFin", "Facturas", "NumFin<" & Me.NumFin & "and left([nfactura],2)='" & Me.ElegirSerie & "'")) + 1), "0000")
ElseIf d > 1 Then
For c = 1 To d
Faltan = Nz([Faltan], "") & "," & Left([NFactura], 2) & "" & Mid([NFactura], 3, 1) & "" & Format((Nz(DMax("NumFin", "Facturas", "NumFin<" & Me.NumFin & "and left([nfactura],2)='" & Me.ElegirSerie & "'")) + c), "0000")
Next c
End If
DoCmd.GoToRecord , , acNext
Next
Faltan = Mid([Faltan], 2, Len([Faltan]) - 1)
End Sub
Le presento esta otra alternativa, no requiere de campos adicionales. Consta de 1 tabla 1 formulario y 1 módulo
TABLA
FORMULARIO
CÓDIGO DEL FORMULARIO
Evento Al cargar (Para llenar el cuadro combinado)
Private Sub Form_Load() Dim strSQL As String strSQL = "SELECT Left(factura,2) AS prefijo FROM tbfactura GROUP BY Left(factura,2) ORDER BY Left(factura,2);" Me.cboPrefijo.RowSource = strSQL End Sub
Evento Después de Actualizar del cuadro combinado
Private Sub cboPrefijo_AfterUpdate() Me.ctlFaltan = faltantes(Me.cboPrefijo) End Sub
Módulo con la función faltantes.
Public Function faltantes(strSerie As String) As String
On Error GoTo hay_error
'Función para determinar las facturas que faltan en una serie
'Se parte de que la factura tiene el siguiete formato:
' LA01112 --- en donde LA el serial y 00001 es el consecutivo
'Parámetros:
' strSerie, por ejemplo FC,GD,HT
'
'Ejemplo llamada:
' faltantes("LA")
'Elaborada por:
' EDUARDO PÉREZ FERNÁNDEZ - 06/07/2023
Dim rst As DAO.Recordset
Dim x As Integer
Dim num As Integer
Dim flag As Boolean
Dim dbID As Integer
Dim strFaltan As String
Dim strSQL As String
Dim ctafacturas As Integer
strSQL = "SELECT tbfactura.factura" & vbCrLf
strSQL = strSQL & " FROM tbfactura" & vbCrLf
strSQL = strSQL & " WHERE Mid([factura],1,2)='" & UCase(strSerie) & "'" & vbCrLf
strSQL = strSQL & " ORDER BY tbfactura.factura;"
Set rst = CurrentDb.OpenRecordset(strSQL)
' Stop
If rst.RecordCount > 0 Then
ctafacturas = Right(Nz(DLast("factura", "tbfactura", "Mid([factura],1,2)='" & strSerie & "'")), 5)
num = Right(Nz(DFirst("factura", "tbfactura", "Mid([factura],1,2)='" & strSerie & "'")), 5)
Else
faltantes = strSerie & "0001"
Exit Function
End If
For x = num To ctafacturas
flag = False
Do While Not rst.EOF
dbID = Val(Right(rst!factura, 5))
If dbID = x Then
flag = True
End If
rst.MoveNext
Loop
If flag = False Then
strFaltan = strFaltan & UCase(strSerie) & Format(x, "00000") & ","
End If
rst.MoveFirst
Next
If Len(strFaltan) > 0 Then
faltantes = Mid(strFaltan, 1, Len(strFaltan) - 1)
Else
faltantes = "LA NUMERACIÓN ESTA COMPLETA"
End If
rst.Close
Set rst = Nothing
hay_error_exit:
Exit Function
hay_error:
MsgBox "Ocurrió el error " & Err.Number & " " & Err.Description, vbCritical, "Error..."
Resume hay_error_exit
End FunctionAunque utilizo un módulo puede convertir el código en un procedimiento para llamarlo dentro del formulario. Si quiere el ejemplo lo puede solicitar a [email protected]
La ventaja de la función que puede utilizarla en una consulta para obtener todos los faltantes.
CONSULTA
Resultado
