Attribute VB_Name = "Comparer_Contenu_v122"
'----------------------------------------------------------------------------------------
' Procédure_____: Comparer_Contenu
' Date__________: 08/01/2022
' Auteur________: www.CapLSS.com - https://www.caplss.com/viewtopic.php?t=271
' Objet_________: Retourner le nombre d'éléments différents trouvés
' Référence_____: Fonction de recherche
' Appel_________: Comparer_Contenu(x_LeRange1, x_LeRange2, Opt. x_LeSens, Opt. PasdInfo)
' Appel_________: /!\ Nécessite : Ajouter_Si_Nouveau
' Appel_________: /!\ Nécessite : Retirer_Si_Existe
' Appel_________: /!\ Nécessite : Imploser
' Retour________: Nombre d'éléments non-vide différents, 0 si aucun écart
' Options_______: Si x_LeSens = "<" supprime x_LeRange2 du x_LeRange1 uniquement
' Options_______: Si x_LeSens = ">" supprime x_LeRange1 du x_LeRange2 uniquement
' Options_______: Si PasdInfo := true, n'Affiche pas de message si non trouvé
' Compatibilité_: (2003-2019)Office     (11.0-16.0)Excel     (+)32-bit     (+)64-bit
' Statut________: (x)Validé ()En attente validation ()En cours développement
'----------------------------------------------------------------------------------------
' 2013.02.16 v1.00 DEV Création initiale, fournit le nombre d'écarts constatés.
' 2021.03.20 v1.10 BUG La fonction .Find() n'est pas (plus) fonctionnelle sur colonnes masquées.
'                  FIX Refonte complète, compatibilité Office 2019 et Excel 17.
' 2022.01.07 v1.20 DEV Ajoute la possibilité de ne comparer que dans un sens.
' 2022.01.08 v1.21 DEV Ajout de précisions dans l'affichage des résultats (Zones et Valeurs).
' 2022.01.26 v1.22 DEV Améliore la stabilité du programme et compatibilité VBA7
'
Option Explicit

Function Comparer_Contenu(ByVal x_LeRange1 As Variant, ByVal x_LeRange2 As Range, Optional ByVal x_LeSens As String, Optional ByVal PasdInfo As Boolean) As Variant
  '
  ' Note : Fonction .Find non fonctionnelle sur cellules masquées (xlvalues ou xlFormulas)
  '
  ' /!\ Attention, nécessite Ajouter_Si_Nouveau, Retirer_Si_Existe, et Imploser
  '
  ' Sens de Comparaison
  Dim x_Gauche, x_Droite As Boolean
  Select Case x_LeSens
    Case "<"
      x_Gauche = True
      x_Droite = False
    Case ">"
      x_Gauche = False
      x_Droite = True
    Case Else
      x_Gauche = True
      x_Droite = True
  End Select
  ' Variables
  Comparer_Contenu = 0
  Dim x_LaValeur As Variant
  Dim x_Nb1, x_Nb2 As Variant
  x_Nb1 = 0
  x_Nb2 = 0
  ' Affecter la Pile01
  Dim Pile01() As Variant
  ReDim Pile01(0)
  For Each x_LaValeur In x_LeRange1
    x_Nb1 = x_Nb1 + Ajouter_Si_Nouveau(x_LaValeur.Value, Pile01)
  Next x_LaValeur
  ' Affecter la Pile02
  Dim Pile02() As Variant
  ReDim Pile02(0)
  For Each x_LaValeur In x_LeRange2
    x_Nb2 = x_Nb2 + Ajouter_Si_Nouveau(x_LaValeur.Value, Pile02)
  Next x_LaValeur
  ' Comparaison à Gauche
  If x_Gauche Then
    ' Affecter le Reste01
    Dim Reste01() As Variant
    Reste01 = Pile01
    For Each x_LaValeur In Pile02
      x_Nb1 = x_Nb1 - Retirer_Si_Existe(x_LaValeur, Reste01)
    Next x_LaValeur
  Else
    x_Nb1 = 0
  End If
  ' Comparaison à Droite
  If x_Droite Then
    ' Affecter le Reste02
    Dim Reste02() As Variant
    Reste02 = Pile02
    For Each x_LaValeur In Pile01
      x_Nb2 = x_Nb2 - Retirer_Si_Existe(x_LaValeur, Reste02)
    Next x_LaValeur
  Else
    x_Nb2 = 0
  End If
  ' Résultats
  Comparer_Contenu = x_Nb1 + x_Nb2
  ' Affichage (si non interdit)
  If Not PasdInfo Then
    If x_Gauche Then
       Dim Liste01 As String
       Liste01 = Imploser(", ", Reste01)
    End If
    If x_Droite Then
       Dim Liste02 As String
       Liste02 = Imploser(", ", Reste02)
    End If
    Dim Message0, Message1, MessageG, MessageD As String
    If x_Gauche And x_Droite Then
      Message0 = "Comparaison croisée"
    ElseIf x_Gauche Then
      Message0 = "Comparaison unique Range1 - Range2"
    Else
      Message0 = "Comparaison unique Range2 - Range1"
    End If
    If (x_Gauche And Not x_Droite And x_Nb1 = 0) Or (Not x_Gauche And x_Droite And x_Nb2 = 0) Or (x_Nb1 + x_Nb2 = 0) Then
      Message1 = "Toutes les Valeurs ont été trouvées dans l'autre zone."
    Else
      Message1 = x_Nb1 + x_Nb2 & " valeur(s) orpheline(s) trouvée(s)"
    End If
    MessageG = ""
    MessageD = ""
    If x_Gauche Then
      MessageG = Chr(10) & Chr(10) & x_Nb1 & " uniquement dans " & x_LeRange1.Worksheet.Name & "[" & x_LeRange1.Address & "] " & Chr(10) & Liste01
    Else
      MessageG = Chr(10) & Chr(10) & "Comparé avec " & x_LeRange1.Worksheet.Name & "[" & x_LeRange1.Address & "]"
    End If
    If x_Droite Then
      MessageD = Chr(10) & Chr(10) & x_Nb2 & " uniquement dans " & x_LeRange2.Worksheet.Name & "[" & x_LeRange2.Address & "] " & Chr(10) & Liste02
    Else
      MessageD = Chr(10) & Chr(10) & "Comparé avec " & x_LeRange2.Worksheet.Name & "[" & x_LeRange2.Address & "]"
    End If
    '
    MsgBox Message1 & MessageG & MessageD, Buttons:=vbInformation, Title:=Message0
    '
  End If
End Function