XL 2013 Rechercher des valeurs qui ne sont pas dans une colonne

job75 à dit:

Merci pour le fichier, voici le nouveau code adapté aux nouvelles colonnes traitées :

VB:

Private Sub Worksheet_Activate()
Worksheet_Change [A1] 'lance la macro
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim F As Worksheet, FF As Worksheet, dest As Range, d As Object, col, colF%, colFF%, tablo, i&, x$, resu$(), n&
Set F = Sheets("Planning") 'véhicules utilisés
Set FF = Sheets("Base des données") 'immatriculations
Set dest = [A1] '1ère cellule du tableau des résultats
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
If FilterMode Then ShowAllData 'si la feuille est filtrée
Set d = CreateObject("Scripting.Dictionary")
For Each col In Array(1, 3) 'colonnes A et C
    colF = IIf(col = 1, 14, 15) 'colonnes N et O
    colFF = IIf(col = 1, 5, 6) 'colonnes E et F
    tablo = F.Cells(1, colF).Resize(F.Cells(F.Rows.Count, colF).End(xlUp).Row, 2) 'matrice, plus rapide, au moins 2 éléments
    d.RemoveAll 'RAZ
    For i = 2 To UBound(tablo)
        x = tablo(i, 1)
        If x <> "" Then d(x) = "" 'liste sans doublon
    Next i
    tablo = FF.Cells(1, colFF).Resize(FF.Cells(FF.Rows.Count, colFF).End(xlUp).Row, 2) 'matrice, plus rapide, au moins 2 éléments
    ReDim resu(1 To UBound(tablo), 1 To 1)
    n = 0 'RAZ
    For i = 2 To UBound(tablo)
        x = tablo(i, 1)
        If x <> "" And Not d.exists(x) Then n = n + 1: resu(n, 1) = x
    Next i
    '---restitution---
    If n Then dest(2, col).Resize(n) = resu
    dest(1, col).Resize(n + 1).Borders.Weight = xlThin 'bordures
    dest(2, col).Offset(n).Resize(Rows.Count - n - dest.Row).Delete xlUp 'RAZ en dessous
Next col
Application.EnableEvents = True 'réactive les évènements
End Sub

Cliquez pour agrandir...

Bonjour haonv,
J'ai renommé les champs mais il ne se passe rien quand je complète le tableau de la feuille "planning" (colonne E ou O).
Est ce que tu peut regarder ou est que j'ai pu faire l'erreur ?

Cliquez pour agrandir...

{=SIERREUR(INDEX(Tableau234;PETITE.VALEUR(NON(NB.SI(TracteurF1;Tableau234))*LIGNE(Tableau234);LIGNES($1:2)+NBVAL(TracteurF1)-1)-1);"")}

haonv à dit:

Bonjour à tous,


Puisque les données "tracteurs" par exemple sont déjà dans un tableau, ce n'est plus la peine de faire une liste qui s'ajuste aux données.
En A2 sur la feuille "Véhicules Dispo", par exemple, la formule devrait être:

VB:

{=SIERREUR(INDEX(Tableau234;PETITE.VALEUR(NON(NB.SI(TracteurF1;Tableau234))*LIGNE(Tableau234);LIGNES($1:2)+NBVAL(TracteurF1)-1)-1);"")}

Par contre sur la feuille "planning" tu as des valeurs en N3 et N4, puis ensuite tu en as en N58 et N60.
Est-ce normal ?
Et tu as aussi une multitude de noms dans le gestionnaire....

Cordialement

Cliquez pour agrandir...

job75 à dit:

Faites une copie du fichier réel, allégé et anonymisé, avec les bonnes colonnes à traiter.

Cliquez pour agrandir...

Paul-Emile à dit:

Est ce je dois crée un macro pour chaque feuille du jour de la semaine ?

Cliquez pour agrandir...

Set F = Sheets("Planning")

Set F = Sheets("lundi")

job75 à dit:

Bonjour Paul-Emile,

Si vous voulez économiser du code placez dans ThisWorkbook :

VB:

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Sh.Name Like "Véhic. Dipo.*?" Then Workbook_SheetChange Sh, Sh.[A1] 'lance la macro
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Not Sh.Name Like "Véhic. Dipo.*?" Then Exit Sub
Dim jour$, F As Worksheet, FF As Worksheet, dest As Range, d As Object, col, colF%, colFF%, tablo, i&, x$, resu$(), n&
jour = Trim(Mid(Sh.Name, InStrRev(Sh.Name, ".") + 1)) 'Lundi Mardi etc...
Set F = Sheets(jour) 'véhicules utilisés
Set FF = Sheets("Base des données") 'immatriculations
Set dest = Sh.[A1] '1ère cellule du tableau des résultats
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
If Sh.FilterMode Then Sh.ShowAllData 'si la feuille est filtrée
Set d = CreateObject("Scripting.Dictionary")
For Each col In Array(1, 3) 'colonnes A et C
    colF = IIf(col = 1, 14, 15) 'colonnes N et O
    colFF = IIf(col = 1, 5, 6) 'colonnes E et F
    tablo = F.Cells(1, colF).Resize(F.Cells(F.Rows.Count, colF).End(xlUp).Row, 2) 'matrice, plus rapide, au moins 2 éléments
    d.RemoveAll 'RAZ
    For i = 2 To UBound(tablo)
        x = tablo(i, 1)
        If x <> "" Then d(x) = "" 'liste sans doublon
    Next i
    tablo = FF.Cells(1, colFF).Resize(FF.Cells(FF.Rows.Count, colFF).End(xlUp).Row, 2) 'matrice, plus rapide, au moins 2 éléments
    ReDim resu(1 To UBound(tablo), 1 To 1)
    n = 0 'RAZ
    For i = 2 To UBound(tablo)
        x = tablo(i, 1)
        If x <> "" And Not d.exists(x) Then n = n + 1: resu(n, 1) = x
    Next i
    '---restitution---
    If n Then dest(2, col).Resize(n) = resu
    dest(1, col).Resize(n + 1).Borders.Weight = xlThin 'bordures
    dest(2, col).Offset(n).Resize(Rows.Count - n - dest.Row).Delete xlUp 'RAZ en dessous
Next col
Application.EnableEvents = True 'réactive les évènements
End Sub

Et effacez toutes les macros Worksheet_Activate et Worksheet_Change.

Chez moi le gain en nombres d'octets est peu important (6 Ko).

A+

Cliquez pour agrandir...