Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

comparaison de deux colonnes

osishame

XLDnaute Junior
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.
 

Pièces jointes

  • Macro2.xls
    177 KB · Affichages: 42
  • Macro2.xls
    177 KB · Affichages: 55
  • Macro2.xls
    177 KB · Affichages: 49

osishame

XLDnaute Junior
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

XLDnaute Barbatruc
Repose en paix
Re : comparaison de deux colonnes

Bonjour,

Code:
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

Code:
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

Code:
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
 

Pièces jointes

  • Copie de Macro2.zip
    349.9 KB · Affichages: 45
Dernière édition:

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…