comparaison de deux colonnes

[osishame]

Bonsoir le forum,

Je reviens vers vous avec le problème suivant :
Je n’arrive pas à comparer deux tableaux (Onglet Crapull et onglet BE) sans prendre en compte la casse et les accents.
Les résultats souhaités sont répartis dans 3 onglets différents et lancés à partir de 3 macros distincts:
- Onglet « Sorties » (Macro C_BEvsCrapull): Je suis censée avoir les lignes présentes dans le tableau BE et non dans Crapull (sans tenir compte des majuscules et des accents)
- Onglet « Entrées » (Mavro D_C: Je suis censée avoir les lignes présentes dans le tableau Crapull et non dans BE (sans tenir compte des majuscules et des accents)
- Onglet « Code Communs » (Macro E_CommunCode): Je suis censée avoir les lignes présentes dans les 2 tableaux BE et Crapull

Pour plus de transparence, j'ai mis les résultats souhaités dans le fichier joint !

Question subsidiaire, je n’arrive pas a gérer les doublons lors de la comparaison : pour deux lignes avec la même valeur dans le tableau BE et seulement une ligne dans le tableau Crapull. Est-ce possible ?
Résultat souhaité :
- Onglet « Sorties » : une ligne
- Onglet « Sorties » : une ligne
Résultat actuel :
- Onglet « Sorties » : pas de ligne
- Onglet « Sorties » : une ligne

Merci beaucoup pour votre aide !!

osi.

 

[osishame]

Re : comparaison de deux colonnes

Bonjour le forum,

Je n'arrive pas en fait a intégrer ce code dans ma macro C_BEvsCrapull et D_CrapullvsBE:

Function sansAccent(chaine)
codeA = "ÉÈÊËÔéèêëàçùôûïî"
codeB = "EEEEOeeeeacuouii"
temp = chaine
For i = 1 To Len(temp)
p = InStr(codeA, Mid(temp, i, 1))
If p > 0 Then Mid(temp, i, 1) = Mid(codeB, p, 1)
Next
sansAccent = temp
End Function

Mes macros séparent bien les lignes des 2 tableaux comme voulu en comparant les valeurs de la colonne A (Noms) mais sans tenir compte de la casse. La répartition finale est donc erronée...

Merci beaucoup pour votre aide, je suis au point mort...
Bonne journée à tous !

osi.

 

[BOISGONTIER]

Re : comparaison de deux colonnes

Bonjour,

Sub CommunsCode()
  Application.ScreenUpdating = False
  Set f1 = Sheets("BE")
  Set f2 = Sheets("Crapull")
  Set f3 = Sheets("Communs Code")
  f3.[A2:C65000].ClearContents
  f3.[A2:C65000].Interior.ColorIndex = xlNone
  a = f1.Range("A1").CurrentRegion.Value
  b = f2.Range("A1").CurrentRegion.Value
  Set mondico2 = CreateObject("Scripting.Dictionary")
  For i = 2 To UBound(a)
    mondico2(UCase(sansAccent(a(i, 1)))) = ""
  Next i
  ligne = 2
  For i = 2 To UBound(b)
    temp = ""
    For K = 1 To UBound(b, 2): temp = temp & b(i, K): Next K
    If mondico2.Exists(UCase(sansAccent(b(i, 1)))) Then
      For K = 1 To UBound(b, 2)
         f3.Cells(ligne, K) = b(i, K)
      Next K
      ligne = ligne + 1
    End If
  Next
End Sub

Function sansAccent(chaine)
  codeA = "ÉÈÊËÔéèêëàçùôûïî"
  codeB = "EEEEOeeeeacuouii"
  temp = chaine
  For i = 1 To Len(temp)
    p = InStr(codeA, Mid(temp, i, 1))
    If p > 0 Then Mid(temp, i, 1) = Mid(codeB, p, 1)
  Next
  sansAccent = temp
End Function

Sub F1_nonF2()
  Application.ScreenUpdating = False
  Set f1 = Sheets("Crapull")
  Set f2 = Sheets("BE")
  'on définit a et b comme étant les 2 tableaux BD1 et BD2'
  a = f2.Range("A1").CurrentRegion.Value
  b = f1.Range("A1").CurrentRegion.Value
  Set mondico1 = CreateObject("Scripting.Dictionary")
  Set mondico2 = CreateObject("Scripting.Dictionary")
  'On crée un dictionnaire de données sur la ligne i et la colonne 1'
    For i = 2 To UBound(a): mondico1(UCase(sansAccent(a(i, 1)))) = "": Next i
    ligne = 1
    Dim c
    ReDim c(1 To Application.Max(UBound(a), UBound(b)), 1 To UBound(a, 2))
    For i = 2 To UBound(b)
      If Not mondico1.Exists(UCase(sansAccent(b(i, 1)))) Then
        For K = 1 To UBound(b, 2): c(ligne, K) = b(i, K): Next K
        ligne = ligne + 1
      End If
    Next
    Sheets("Entrées").[A2].Resize(UBound(a, 1), UBound(a, 2)) = c
End Sub

Function sansAccent(chaine)
   codeA = "ÉÈÊËÔéèêëàçùôûïî"
   codeB = "EEEEOeeeeacuouii"
   temp = chaine
   For i = 1 To Len(temp)
    p = InStr(codeA, Mid(temp, i, 1))
    If p > 0 Then Mid(temp, i, 1) = Mid(codeB, p, 1)
   Next
   sansAccent = temp
End Function

Sub F1_nonF2()
  Application.ScreenUpdating = False
  Set f1 = Sheets("BE")
  Set f2 = Sheets("Crapull")
  'on définit a et b comme étant les 2 tableaux BD1 et BD2'
  a = f2.Range("A1").CurrentRegion.Value
  b = f1.Range("A1").CurrentRegion.Value
  Set mondico1 = CreateObject("Scripting.Dictionary")
  Set mondico2 = CreateObject("Scripting.Dictionary")
  'On crée un dictionnaire de données sur la ligne i et la colonne 1'
  For i = 2 To UBound(a): mondico1(UCase(sansAccent(a(i, 1)))) = "": Next i
    ligne = 1
    Dim c
    ReDim c(1 To Application.Max(UBound(a), UBound(b)), 1 To UBound(b, 2))
    For i = 2 To UBound(b)
      If Not mondico1.Exists(UCase(sansAccent(b(i, 1)))) Then
        For K = 1 To UBound(b, 2): c(ligne, K) = b(i, K): Next K
        ligne = ligne + 1
      End If
    Next
    Sheets("Sorties").[A2].Resize(UBound(a, 1), UBound(a, 2)) = c
End Sub

Function sansAccent(chaine)
   codeA = "ÉÈÊËÔéèêëàçùôûïî"
   codeB = "EEEEOeeeeacuouii"
   temp = chaine
   For i = 1 To Len(temp)
    p = InStr(codeA, Mid(temp, i, 1))
    If p > 0 Then Mid(temp, i, 1) = Mid(codeB, p, 1)
   Next
   sansAccent = temp
End Function

JB

 

[osishame]

Re : comparaison de deux colonnes

Ça marche!! Merci beaucoup JB

Il ne me reste plus qu'à élucider la gestion des doublons dans la comparaison des 2 colonnes...