XL 2019 vba trouver un nombre manquant dans une suite donnee

maguie

XLDnaute Junior
Bonjour,
Je vous explique ma problématique. J'ai une suite de nombre (numéro de facture : 2018001) et je souhaiterais trouver les numéros de factures manquants dans une suite donnée avec un minimum et un maximum sachant que ce sont des grands nombres.
exemple de numéros : [2018001,2018002,20018004, 20180005..., 20180050]. Ma problématique est de trouver par exemple les numéros de facture manquants en précisant que le début est 20180001 et la fin 20180050. Et que la fonction vba doit rechercher ce nombre dans cet intervalle uniquement.
Par avance merci
Cordialement
 

chris

XLDnaute Barbatruc
Bonjour
J'ai regardé ce qui se faisait sur power pivot et powerQuerry. Il y a t-il des cours en ligne ou des informations sur le sujet?
Merci beaucoup
Bonjour à tous

Le site de MicroSoft donne quelques exemples et toute la référence du langage M utilisé par PowerQuery mais en français la seule référence réellement didactique à mon avis est le livre d'ENI de Cathy MONIER Power Query et le langage M

Le site du CFO masqué est intéressant aussi avec régulièrement des conférences gratuites d'une heure en ligne
 

maguie

XLDnaute Junior
Bonjour à tous

Le site de MicroSoft donne quelques exemples et toute la référence du langage M utilisé par PowerQuery mais en français la seule référence réellement didactique à mon avis est le livre d'ENI de Cathy MONIER Power Query et le langage M

Le site du CFO masqué est intéressant aussi avec régulièrement des conférences gratuites d'une heure en ligne
Super et merci beaucoup
 

job75

XLDnaute Barbatruc
je ne suis pas sur qu'un test if d.exist soit moins lourd que match
C'est une des bonnes raisons d'utiliser le Dictionary.
Fichier joint avec ces 2 macros :
VB:
Sub Dictionary()
Dim t, d As Object, tablo, i&, n&
t = Timer
Set d = CreateObject("Scripting.Dictionary")
tablo = [A2:A50000]
For i = 1 To UBound(tablo)
    d(tablo(i, 1)) = ""
Next
For i = Application.Min(tablo) To Application.Max(tablo)
    If Not d.exists(i) Then n = n + 1
Next
[D3] = Timer - t
[D6] = n
End Sub

Sub Match()
Dim t, P As Range, tablo, i&, n&
t = Timer
Set P = [A2:A50000]
tablo = P
For i = Application.Min(tablo) To Application.Max(tablo)
    If IsError(Application.Match(i, P, 0)) Then n = n + 1
    'If IsError(Application.Match(i, tablo, 0)) Then n = n + 1 'bien plus long
Next
[D4] = Timer - t
[D6] = n
End Sub
 

Pièces jointes

  • Classeur(1).xlsm
    438.7 KB · Affichages: 12

patricktoulon

XLDnaute Barbatruc
bonsoir @job75
oui j'avais essayé mea-culpa
j'ai essayé aussi ce raisonnement avec une collection mais ca ne fonctionne pas

VB:
Sub aaaa()créée une liste avec des manquants
For i = 1 To 1000
If i Mod 5 = 0 Or i Mod 7 = 0 Then
Else
a = a + 1: Cells(a, 1) = 2018001 + i
End If
Next
End Sub




Sub test()
Dim P As Range, mini&, maxi&, tablo, i&, n&, collect1 As New Collection, tbl()
Set P = [A1].CurrentRegion 'à adapter

mini = Application.Min(P)
maxi = Application.Max(P)
MsgBox mini & vbCrLf & maxi

tablo = P.Value 'matrice, plus rapide, au moins 2 éléments
'---liste des numéros sans doublons---
For i = 1 To UBound(tablo):    collect1.Add Val(tablo(i, 1)): Next ' on collectionne
'---liste des manquants---
For i = mini To maxi
On Error Resume Next'l'erreur se déclenche si on tente de mettre une valeur existante dans la collection
collect1.Add i
If Err.Number = 0 Then n = n + 1: ReDim Preserve tbl(1 To n): tbl(n) = i: Err.Clear'visiblement l'erreur nest pas déclenchée puisque j'obtient le mini au maxi dans la collection  soit le nombe du tableau de base +les manquants
Next
MsgBox UBound(tbl)
[B1].Resize(UBound(tbl), 1) = Application.Transpose(tbl)
'msgbox Join(tbl, vbCrLf)

End Sub
voila que ma collection est en panne 🤣
 

Nico004

XLDnaute Nouveau
Voyez le fichier joint et cette macro dans le code de Feuil1 (clic droit sur l'onglet et Visualiser le code) :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim P As Range, prem&, der&, mini&, maxi&, d As Object, resu(), tablo, i&, n&
Set P = [A1].CurrentRegion.Columns(2) 'à adapter
prem = Val([E2]): der = Val([E3]) 'à adapter
mini = Application.Min(P)
maxi = Application.Max(P)
prem = IIf(prem > mini, prem, mini)
der = IIf(der > maxi, maxi, der)
Set d = CreateObject("Scripting.Dictionary")
tablo = P.Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
'---liste des numéros sans doublons---
For i = 2 To UBound(tablo)
    d(tablo(i, 1)) = ""
Next
'---liste des manquants---
ReDim resu(1 To UBound(tablo), 1 To 1)
For i = prem To der
    If Not d.exists(i) Then n = n + 1: resu(n, 1) = i
Next
'---restitution---
Application.EnableEvents = False 'désactive les évènements
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [E6] '1ère cellule de destination, à adapter
    If n Then .Resize(n) = resu
    .Offset(n).Resize(Rows.Count - n - .Row + 1).ClearContents 'RAZ en dessous
End With
Application.EnableEvents = True 'réactive les évènements
End Sub
Elle se déclenche quand on modifie ou valide une cellule quelconque.

L'exécution est très rapide car on utilise des tableaux VBA et le Dictionary.

A+
Merci Beaucoup Job75!!!
Grace a toi je vais gagner un temps de malade!!!
MERCI MERCI MERCI
 

Discussions similaires

Statistiques des forums

Discussions
311 710
Messages
2 081 781
Membres
101 817
dernier inscrit
carvajal