Discussion :

[ARFAOUI1953]

J'ai une table facture sous ACCESS 2007 qui contient une colonne NuméroFacture trié séquentiellement du plus petit au plus grand. j'ai identifié les numéros doubles mais j'ai pas su comment détecter les numéros qui sautent (les trous) par requête SQL sous Access ou requête ACCESS.
Merci,Tunis le 12 Avril 2013 à 10h56

[tee_grandbois]

Bonjour la Tunisie ,
Voici un code adapté à tes besoins, qui m'a beaucoup servi il y a quelques temps, il te crée une table avec les numéros disponibles :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
Function fChercheSeries(pNomTable As String, pNomChamp As String)
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
' Recherche de plages de numéros disponibles  dans une table         "
'                                                                    "
' Paramètres : pNomTable : nom de la table contenant les données     "
'              pNomChamp : nom du champ de la table                  "
' Exemple : call fChercheSeries("Exemple", "champcle")               "
'                                                                    "
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
 
Dim lgDebInterv As Long
Dim lgFinInterv As Long
Dim lgInterval As Long
Dim I As Long
Dim boChpOK As Boolean
Dim oRst As Recordset
Dim oRstI As Recordset
Dim oRstO As Recordset
Dim stSQL As String
Dim stNomTable As String
 
On Error GoTo Gest_Erreur
' Contrôle existence table
    If IsNull(DLookup("[Name]", "Msysobjects", "[Type] = 1 and [Name]='" & pNomTable & "'")) Then
        MsgBox "Table " & pNomTable & " non trouvée dans la base.", , "RechercheSeries"
        Exit Function
    End If
 
' Contrôle existence du champ dans la table
    Set oRst = CurrentDb.OpenRecordset(pNomTable)
    For I = 0 To oRst.Fields.Count - 1
        If oRst.Fields(I).Name = pNomChamp Then
            boChpOK = True
            Exit For
        End If
    Next I
    oRst.Close
    Set oRst = Nothing
 
    If Not boChpOK Then
        MsgBox "Champ " & pNomChamp & " inexistant dans la table " & pNomTable & ".", , "RechercheSeries"
        Exit Function
    End If
' Contrôle existence données
    If DCount("*", pNomTable) = 0 Then
        MsgBox "La table " & pNomTable & " ne contient aucun enregistrement.", , "RechercheSeries"
        Exit Function
    End If
 
' Construction du nom de la table résultat
    stNomTable = "Series_" & pNomTable
    lgDebInterv = 1
    DoCmd.SetWarnings False
 
' Suppression de la table résultat si elle existe
    DoCmd.DeleteObject acTable, stNomTable
 
' Création de la table
    CurrentDb.Execute "CREATE TABLE " & stNomTable & "(" & pNomChamp & " Long)"
 
    Set oRstI = CurrentDb.OpenRecordset("SELECT " & pNomChamp & " FROM " & pNomTable & " ORDER BY 1;")
    Set oRstO = CurrentDb.OpenRecordset(stNomTable, dbOpenDynaset)
 
        While Not oRstI.EOF
 
            lgFinInterv = oRstI.Fields(pNomChamp)
            ' Calcul de la série entre 2 enregistrements
                        ' Si premier enregistrement
                If lgDebInterv = 1 And oRstI.AbsolutePosition = 0 Then
                    lgInterval = lgFinInterv - 1
                Else    ' Si autres enregistrements
                    lgInterval = (lgFinInterv - 1) - (lgDebInterv)
                End If
 
            ' Ecriture des intervalles
            If lgInterval > 0 Then
                For J = lgDebInterv + 1 To lgFinInterv - 1
                    oRstO.AddNew
                    oRstO.Fields(0) = J
                    oRstO.Update
                Next J
            End If
            lgDebInterv = lgFinInterv
 
           oRstI.MoveNext
 
        Wend
 
 
    DoCmd.SetWarnings True
    oRstI.Close
    oRstO.Close
    Set oRstI = Nothing
    Set oRstO = Nothing
 
    MsgBox "Recherche de séries terminée pour la table " & pNomTable, , "RechercheSeries"
 
Sortie_Fonction:
    Exit Function
 
Gest_Erreur:
 
        Select Case Err.Number
        Case 7874   ' table de travail non trouvée
        Resume Next
        Case Else
            MsgBox Err.Number & " Erreur - " & Err.Description, , "RechercheSeries"
            Resume Sortie_Fonction
        End Select
 
 
End Function

[philben]

bjr,

par une requête ...

philippe