Trouver les nombres manquants dans une suite de chiffre

Bonjour à tous,

J'ai un problème qui a déjà été traité plusieurs fois sur internet (et même sur ce forum) mais toutes les solutions que j'ai trouvé ne fonctionnent pas sur ma machine (peut-être que je lui en demande trop ?).

J'ai dans une colonne une suite croissante de chiffres avec certains numéros manquants et je souhaite avoir une liste de ces numéros manquants dans une autre colonne. Un problème somme tout classique dont j'ai trouvé plusieurs solutions qui fonctionnent sur des petites suites. Mon problème concerne une suite de plus de 30 000 lignes et aucunen de ces solutions précédentes ne fonctionnent sur une si grande suite. Je me dis qu'il y a peut-être moyen d'optimiser car ma suite est croissante et qu'il n'y a jamais un trou de plus de 100 chiffres (pas besoin donc de comparer avec toute la liste) et pas de doublons. Jusqu'a présent, les résultats données par les solutions trouvés par internet sont soit complétement faux sur cette formule, soit font bugé mon pc. Pouvez-vous m'aider à trouver une solution qui m'évite de passer à la main sur les résultats en affichant en rouge par ex les endroits où il y a une rupture de la suite (en faisant A(i)-A(i-1)=1) ?

Je suis désolé, je n'ai pas mon fichier lorsque je crée ce poste mais je le joindrais ce soir en rentrant. Merci d'avance

Bonjour,

Une proposition Power Query.
On crée une table des nombres manquants.
Cdlt.

bonjour,

edit : Salut Jean-Eric

une proposition

Sub aargh()
    Dim r()
    With ActiveSheet 'feuille
        dl = .UsedRange.Rows.Count 'nombre de lignes
        .Range("A1").Resize(dl, 1).Sort key1:=.Range("A1"), order1:=xlAscending, Header:=xlNo 'tri ascendant
        t = .Range("A1").Resize(dl, 1).Value 'mise en tableau des données
        m = Application.Max(t) 'nombre maximum de nombres manquants
        ReDim r(1 To m, 1 To 1) 'tableau des nombres manquants
        For i = 2 To dl
            n1 = t(i - 1, 1) 'premier nombre
            n2 = t(i, 1) 'nombre suivant
            For j = n1 + 1 To n2 - 1 'génère les nombres dans l'intervalle
                k = k + 1
                r(k, 1) = j
            Next j
        Next i
    End With
    Sheets.Add after:=Sheets(1) 'nouvelle feuille
    Range("A1").Resize(k, 1) = r 'copie du tableau des nombres manquants
End Sub

Re,

Bonjour h2so4,

Une petite mise à jour et la procédure.
J'ai tout de même ajouté le tri et la suppression des doublons (?).
Cdlt.

let
    Source = Input,
    Type_numbers = Table.TransformColumnTypes(Source,{{"Nombre", Int64.Type}}),
    Sorted_Rows = Table.Sort(Type_numbers,{{"Nombre", Order.Ascending}}),
    Removed_Duplicates = Table.Distinct(Sorted_Rows),
    Max_Value = List.Max(Removed_Duplicates[Nombre]),
    Partial_List_Created = Removed_Duplicates[Nombre],
    Full_List_Created = {1..Max_Value},
    Difference_Lists = List.Difference(Full_List_Created,Partial_List_Created),
    Convert_List = Table.FromList(Difference_Lists, Splitter.SplitByNothing(), null, null, ExtraValues.Error),
    Column_Name = Table.RenameColumns(Convert_List,{{"Column1", "Nombre"}})
in
    Column_Name

Bonjour Wilane1541, Jean-Eric, H2s04,

Une possibilité avec l'objet dictionnaire qui fait fi des doublons.

Sub Manque()
Der = Range("A" & Rows.Count).End(xlUp).Row
Range("C:C").ClearContents 'Colonne vierge recevant les valeurs manquantes
Set TabNum = Range("A1:A" & Der) 'Tableau des valeurs présentes
Set AbsDico = CreateObject("Scripting.Dictionary") 'Création d'un dictionnaire
Prem = Range("A1"): Fin = Range("A" & Der) 'Boucle 1ière valeur à dernière
For N = Prem To Fin
'Alimentation du dictionnaire par absence de comparaison avec les valeurs présentes
If IsError(Application.Match(N, TabNum, 0)) Then AbsDico(N) = N
Next N
Range("C1").Resize(AbsDico.Count) = Application.Transpose(AbsDico.Items) 'Liste des absents en colonne C
End Sub

Merci beaucoup Jean-Eric, H2s04 et X Cellus,

Votre temps de réponse et votre efficacité m'ont encore surpris une fois de plus. Merci à tous les 3, vous m'avez fait économiser un temps précieux et je comprends la logique dérrière donc je suis, en plus, content ! Bonne soirée

Hello à tous,

Pour le plaisir :

Sub recup_number()

Dim vartab_number()
Dim lnglast_row As Long
Dim i As Long, y As Long, compteur As Long

lnglast_row = Cells(Rows.Count, 1).End(xlUp).Row
vartab_number = Range("A1:A" & lnglast_row)
y = 1
For i = LBound(vartab_number) To UBound(vartab_number) - 1
    If vartab_number(i + 1, 1) > vartab_number(i, 1) + 1 Then
        compteur = vartab_number(i, 1)
        Do While compteur < vartab_number(i + 1, 1) - 1
            Cells(y, 2) = compteur + 1
            y = y + 1
            compteur = compteur + 1
        Loop
    End If
Next i

MsgBox "terminé"

End Sub