XL 2019 VBA TROUVER UN NOMBRE MANQUANT DANS UNE SUITE DONNEE

maguie

XLDnaute Nouveau
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
Re

Ouvre PowerQuery (Données, Obtenir des données, Lancer PowerQuery)

Tu verras les 2 requêtes :
  • Choix qui récupère simplement la table de choix des bornes
  • Factures qui récupères la table des factures et cherche les manquants : tu as les étapes à droite avec le détail dans la barre de formule et en cliquant sur le rouage
J'ai utilisé la technique des suites http://www.excel-formations.fr/Trucs_astuces/PQ05.php

Si l'une ou l'autre étape te pose question, reposte
 

maguie

XLDnaute Nouveau
Re

Ouvre PowerQuery (Données, Obtenir des données, Lancer PowerQuery)

Tu verras les 2 requêtes :
  • Choix qui récupère simplement la table de choix des bornes
  • Factures qui récupères la table des factures et cherche les manquants : tu as les étapes à droite avec le détail dans la barre de formule et en cliquant sur le rouage
J'ai utilisé la technique des suites http://www.excel-formations.fr/Trucs_astuces/PQ05.php
Super. Je vais essayer en soirée car là je pars travailler. Merci à vous tous et très bonne journée.
 

job75

XLDnaute Barbatruc
Bonjour maguie, Phil69970, JHA, chris, le forum,

Voyez le fichier joint et cette formule matricielle en D3 :
Code:
=SIERREUR(PETITE.VALEUR(SI(NON(NB.SI(B:B;MIN(B:B)-1+LIGNE(INDIRECT("1:"&MAX(B:B)-MIN(B:B)+1))));MIN(B:B)-1+LIGNE(INDIRECT("1:"&MAX(B:B)-MIN(B:B)+1)));LIGNE(E1));"")
Elle fonctionne quelle que soit la manière dont le tableau est trié.

A+
 

Pièces jointes

  • Factures manquantes(1).xlsx
    12.3 KB · Affichages: 2
Dernière édition:

Phil69970

XLDnaute Impliqué
Bonjour maguie, JHA, chris, job75, le forum

j'aurais souhaité un code en vba sachant que la suite peut être désordonnée.
Je te propose ce fichier :
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
Tu indiques en E1 et E2 les numéros à rechercher...

@Phil69970
 

Pièces jointes

  • Test N° facture V2.xlsm
    25.8 KB · Affichages: 5

job75

XLDnaute Barbatruc
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+
 

Pièces jointes

  • Factures manquantes VBA(1).xlsm
    19.8 KB · Affichages: 6

maguie

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+
Bonjour.
Super!
Merci à vous tous pour votre contribution vous m'avez merveilleusement aidé.
ça fonctionne à merveille
Très bonne journée à vous tous. Et encore un grand merci pour votre aide.
 

patricktoulon

XLDnaute Barbatruc
bonjour
et ben dis donc ça en fait une machine pour si peu
VB:
Sub test()
Dim tablo, tbl(), i&, a&, mini&, maxi&
tablo = Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
mini = WorksheetFunction.Large(tablo, UBound(tablo))
maxi = WorksheetFunction.Large(tablo, 1)
For i = mini To maxi
X = Application.IfError(Application.Match(i, tablo, 0), 0)
If X = 0 Then a = a + 1: ReDim Preserve tbl(1 To a): tbl(a) = "Il manque la facture N° " & i
Next
[B2].Resize(UBound(tbl)) = Application.Transpose(tbl)
End Sub

c'est pas compliqué tu a un min et un max ben boucle du min au max et teste avec match et c'est tout
 

Discussions similaires

Haut Bas