Comparer "id" avec une valeur alphanumérique

Bonjour,

Grace à un forumeur, j'ai une macro qui fait ce dont j'avais besoin .

Cette macro compare chaque ligne de la Feuil1 à la Feuil2 à partir de l'id de la colonne A puis fait l'inverse (compare chaque ligne de la Feuil2 à la Feuil1 à partir de l'id de la colonne A). Les résultats sont retranscrit dans 2 feuilles de résultats.

J'ai 2 nouveaux besoins, que je n'arrive pas à mettre en oeuvre :

1/ Au départ, les id de la colonne A étaient composés de chiffres. J'ai maintenant des id qui ont des chiffres + des lettres et la macro ne fonctionne pas dans ce cas là et je n'arrive pas à trouver comment résoudre ce problème .

2/ Dans les feuilles de résultats j'aimerai avoir une colonne en C, qui m'indique si l'id est en doublon dans la feuille comparé.

Pour faciliter la compréhension, j'ai mis ces 2 exemples dans le fichier en pièce jointe.

Merci d'avance à ceux qui pourront m'aider

Bonjour Pouloup

Il faut supprimer tout traitement nombre (*1)

Sub Comparaison()
  Set f1 = Sheets("Feuil1")
  Set f2 = Sheets("Feuil2")
  Set fr1 = Sheets("Résultat 1")
  Set fr2 = Sheets("Résultat 2")
  fr1.Cells.Clear
  fr2.Cells.Clear

  tablo1 = f1.Range("A1").CurrentRegion
  ReDim tablo1C(1 To UBound(tablo1, 1), UBound(tablo1, 2))
  tablo1R = tablo1
  fr1.Range("C1").Resize(UBound(tablo1, 1), UBound(tablo1, 2)) = tablo1
  tablo1R = fr1.Range(fr1.Cells(1, 1), fr1.Cells(UBound(tablo1, 1), UBound(tablo1, 2) + 2))

  tablo2 = f2.Range("A1").CurrentRegion
  ReDim tablo2C(1 To UBound(tablo2, 1), UBound(tablo2, 2))
  tablo2R = tablo2
  fr2.Range("C1").Resize(UBound(tablo2, 1), UBound(tablo2, 2)) = tablo2
  tablo2R = fr2.Range(fr2.Cells(1, 1), fr2.Cells(UBound(tablo2, 1), UBound(tablo2, 2) + 2))

  Set dico1 = CreateObject("Scripting.Dictionary")
  Set dico2 = CreateObject("Scripting.Dictionary")
  Set dicoId1 = CreateObject("Scripting.Dictionary")
  Set dicoId2 = CreateObject("Scripting.Dictionary")

  For i = 2 To UBound(tablo1, 1)
    txt = ""
    For j = 1 To UBound(tablo1, 2)
      txt = txt & tablo1(i, j)
    Next j
    dico1(txt) = ""
    'dicoId1(tablo1(i, 1) * 1) = i
    dicoId1(tablo1(i, 1)) = i
  Next i

  For i = 2 To UBound(tablo2, 1)
    txt = ""
    For j = 1 To UBound(tablo2, 2)
      txt = txt & tablo2(i, j)
    Next j
    dico2(txt) = ""
    'dicoId2(tablo2(i, 1) * 1) = i
    dicoId2(tablo2(i, 1)) = i
  Next i

  'Comparaison du tableau1 vs tableau2
  For i = 2 To UBound(tablo1, 1)
    'If dicoId2.exists(tablo1(i, 1)*1) Then
    If dicoId2.exists(tablo1(i, 1)) Then
      tablo1R(i, 1) = "Présent"
      txt = ""
      For j = 1 To UBound(tablo1, 2)
        txt = txt & tablo1(i, j)
      Next j

      If dico2.exists(txt) Then
        tablo1R(i, 2) = "Non"
      Else
        tablo1R(i, 2) = "Oui"
        For j = 2 To UBound(tablo1, 2)   '5
          'If tablo1(i, j) <> tablo2(dicoId2(tablo1(i, 1) * 1), j) Then
          If tablo1(i, j) <> tablo2(dicoId2(tablo1(i, 1)), j) Then
            fr1.Cells(i, j + 2).Interior.Color = RGB(255, 255, 0)
            fr1.Cells(i, j + 2).AddComment
            On Error Resume Next
            'fr1.Cells(i, j + 2).Comment.Text Text:=tablo2(dicoId2(tablo1(i, 1) * 1), j)
            fr1.Cells(i, j + 2).Comment.Text Text:=tablo2(dicoId2(tablo1(i, 1)), j)
            If Err.Number <> 0 Then
              'fr1.Cells(i, j + 2).Comment.Text Text:=Format(tablo2(dicoId2(tablo1(i, 1) * 1), j), "dd mm yyyy")
              fr1.Cells(i, j + 2).Comment.Text Text:=Format(tablo2(dicoId2(tablo1(i, 1)), j), "dd mm yyyy")
              Err.Clear
            End If
          End If
        Next j
      End If
    Else
      tablo1R(i, 1) = "Non Présent"
    End If
  Next i
  fr1.Range("A1").Resize(UBound(tablo1R, 1), UBound(tablo1R, 2)) = tablo1R

  'Comparaison du tableau2 vs tableau1
  For i = 2 To UBound(tablo2, 1)
    'If dicoId1.exists(tablo2(i, 1) * 1) Then
    If dicoId1.exists(tablo2(i, 1)) Then
      tablo2R(i, 1) = "Présent"
      txt = ""
      For j = 1 To UBound(tablo2, 2)
        txt = txt & tablo2(i, j)
      Next j
      If dico1.exists(txt) Then
        tablo2R(i, 2) = "Non"
      Else
        tablo2R(i, 2) = "Oui"
        For j = 2 To UBound(tablo2, 2)
          'If tablo2(i, j) <> tablo1(dicoId1(tablo2(i, 1) * 1), j) Then
          If tablo2(i, j) <> tablo1(dicoId1(tablo2(i, 1)), j) Then
            fr2.Cells(i, j + 2).Interior.Color = RGB(255, 255, 0)
            fr2.Cells(i, j + 2).AddComment
            On Error Resume Next
            'fr2.Cells(i, j + 2).Comment.Text Text:=Format(tablo1(dicoId1(tablo2(i, 1) * 1), j), "dd mm yyyy")
            fr2.Cells(i, j + 2).Comment.Text Text:=Format(tablo1(dicoId1(tablo2(i, 1)), j), "dd mm yyyy")
            Err.Clear
          End If
        Next j
      End If
    Else
      tablo2R(i, 1) = "Non Présent"
    End If
  Next i
  fr2.Range("A1").Resize(UBound(tablo2R, 1), UBound(tablo2R, 2)) = tablo2R

  'Titres
  fr1.Range("A1") = "id Présent dans Feuil1"
  fr1.Range("B1") = "Différence de données"
  fr2.Range("A1") = "id Présent dans Feuil1"
  fr2.Range("B1") = "Différence de données"

  'Copie des 2 feuilles de résultat dans un nouveau fichier
  nom = ActiveWorkbook.Name
  Sheets(Array("Résultat 1", "Résultat 2")).Copy
  Sheets("Résultat 1").Shapes.Range(Array("TextBox 1")).Delete
  Sheets("Résultat 2").Shapes.Range(Array("TextBox 1")).Delete
  Windows(nom).Activate
End Sub

@+

Merci BrunoM45, la comparaison des id alphanumériques fonctionne maintenant, ça va grandement me faciliter la vie :)

Il me reste un souci et cette macro sera au top pour mes besoins. Est-ce que quelqu'un pourrait m'aider pour le point 2 de mon post initial ?

Merci d'avance et bon après-midi