XL 2013 Comparer 4 colonnes Excel et en extraire les données non présentes dans les quatre colonnes

[ykuhn]

Bonjour à tous,

J'ai un tableau EXCEL avec des données sur quatre colonnes et je souhaiterai extraire dans une cinquième colonne les données qui ne sont pas présente dans les quatre colonnes soit avec une formule soit en VBA

Exemple

A	B	C	D	E
1	2	1	2	1
2	3	2	3	6
3	4	3	4	7
4	5	4	5	9
5	6	5	9	11
6	7	6	11

D'avance merci pour votre aide

 

[pierrejean]

Bonjour ykhun
Un essai

 

[ykuhn]

Yesss, ça marche, mille merci…….

 

[mapomme]

Re 🙂,

Une autre version avec possibilité de doublons dans les colonnes. .

Option Explicit
Option Base 1

Sub test()
Dim d(1 To 4) As New Dictionary, t, i&, j&, n&, tot&, r(), s(), clef
 
   t = Range("A1:D" & Range("A" & Rows.Count).End(xlUp).Row)
 
   For j = 1 To 4
      d(j).CompareMode = TextCompare
      For i = 1 To UBound(t)
         If t(i, j) <> "" Then d(j)(CStr(t(i, j))) = ""
      Next i
   Next j
 
   For j = 1 To 4
      For Each clef In d(j)
         n = 0
         For i = 1 To 4
             If d(i).Exists(clef) Then
                n = n + 1
                d(i).Remove clef
             End If
          Next i
         If n <> 4 Then
            tot = tot + 1
            ReDim Preserve r(1 To tot)
            r(tot) = clef
         End If
      Next clef
   Next j
 
   Columns("e:e").Clear
   If tot = 0 Then MsgBox "Toutes les données sont dans les 4 colonnes.": Exit Sub
   ReDim s(1 To tot, 1 To 1)
   For i = 1 To tot: s(i, 1) = r(i): Next
   Columns("e:e").Resize(tot) = s
   Columns("e:e").Resize(tot).Sort key1:=Range("e1"), order1:=xlAscending, Header:=xlNo, MatchCase:=False
   Columns("e:e").Resize(tot).HorizontalAlignment = xlCenter
   Columns("e:e").Resize(tot).Borders.LineStyle = xlContinuous
End Sub

 

[mapomme]

Re,
Une version avec deux 'dictionary' seulement.

Option Compare Text

Sub test()
Dim Gen As New Dictionary, Col As New Dictionary
'Dim t, n&, tot&, r(), s()
Dim i&, j&, k&, t, clef, toutes
  
   Application.ScreenUpdating = False
   If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
   Columns("e:e").Clear
   Gen.CompareMode = TextCompare
   Col.CompareMode = TextCompare
   For j = 1 To 4
      toutes = toutes & Chr(1) & j
      Col.RemoveAll
      k = Cells(Rows.Count, j).End(xlUp).Row
      t = Cells(1, j).Resize(k)
      For i = 1 To k
         clef = CStr(t(i, 1))
         If clef <> "" Then
            If Not Col.Exists(clef) Then
               Col.Add clef, ""
               Gen(clef) = Gen(clef) & Chr(1) & j
            End If
         End If
      Next i
   Next j
   For Each clef In Gen.Keys
      If Gen(clef) = toutes Then Gen.Remove clef
   Next clef
        
   If Gen.Count = 0 Then MsgBox "Tous les élément sont dans toutes les colonnes.": Exit Sub
   ReDim t(1 To Gen.Count, 1 To 1): i = 0
   For Each clef In Gen.Keys: i = i + 1: t(i, 1) = clef: Next
   Columns("e:e").Resize(Gen.Count) = t
   If Gen.Count > 1 Then Columns("e:e").Resize(Gen.Count).Sort key1:=Range("e1"), order1:=xlAscending, Header:=xlNo, MatchCase:=False
   Columns("e:e").Resize(Gen.Count).HorizontalAlignment = xlCenter
   Columns("e:e").Resize(Gen.Count).Borders.LineStyle = xlContinuous
End Sub

 

[mapomme]

Re,

Une version qui fonctionne sur MAC et PC.