Mon code fonctionne mais supprime aussi l'entête

Bonjour à tous,

Me voilà à nouveau dans le besoin d'aide. J'ai essayé par moi-même un bon moment avant de vous écrire mais je pense que je ne regarde pas au bon endroit.

Le but du code ci-dessous et de vérifier la présence de lignes identiques dans 2 feuilles (TESTA) et (TESTB). La vérification se faisant sur chaque ligne et en fonction des valeurs présentes dans les colonnes C et D. Si des lignes sont identiques alors une suppression des lignes identifiées s’exécute mais uniquement dans la feuille TESTA. Le code fonctionne très bien sauf que, comme les feuilles utilisent les mêmes en-têtes de colonnes, la ligne des en-têtes et elle aussi supprimée. L'utilisation d'un Offset m'a semblé efficace mais celui semble causer un problème car l'entête écrase la première ligne qui s'affiche après la suppression.Me voilà donc à demander votre aider pour régler mon problème.

Merci d'avance.

Sub compare_and_delete)

  Dim sh1 As Worksheet, sh2 As Worksheet, dic As Object

  Dim r1 As Range, r2 As Range, a As Variant, b As Variant

  Dim i As Long, lr1 As Long, lr2 As Long

'Feuille source de laquelle les doublons identifiés doivent être supprimés

  Set sh1 = Sheets("TESTA")

'Feuille dans laquelle les doublons doivent être cherchés mais conservés

  Set sh2 = Sheets("TESTB")

  Set dic = CreateObject("Scripting.Dictionary")

'Script de comparaison en considérant que les colonnes C et D comprennent des doublons entre TESTA et TESTB

  dic.CompareMode = vbTextCompare

  lr1 = sh1.Range("C" & Rows.Count).End(xlUp).Row

  lr2 = sh2.Range("C" & Rows.Count).End(xlUp).Row

  a = sh1.Range("C1:D" & lr1).Value2

  b = sh2.Range("C1:D" & lr2).Value2

  Set r1 = sh1.Range("C1" & lr1 + 1)

  Set r2 = sh2.Range("C1" & lr2 + 1)

  For i = 1 To UBound(a, 1)

    dic(a(i, 1) & a(i, 2)) = i

  Next

  For i = 1 To UBound(b, 1)

    If dic.exists(b(i, 1) & b(i, 2)) Then

      Set r1 = Union(r1, sh1.Range("C" & dic(b(i, 1) & b(i, 2))))

      Set r2 = Union(r2, sh2.Range("C" & i))

    End If

  Next

'Supprime les lignes doublons entières dans la feuille source ici "TESTA"

  r1.EntireRow.Delete

  'r1.Offset(1).EntireRow.Delete

End Sub

Bonsoir,

essayez en remplaçant "C1" par "C2" comme cela vous ne prenez plus les entêtes dans vos tableaux. Il faudra alors certainement faire un décalage entre la donnée du tableau et le numéro de ligne de la feuille... Désolé je ne me suis pas assez penché sur votre code.

@ bientôt

LouReeD

Merci, je vais réessayer ça. Une première tentative avait échouée en faisant planter l'exécution. Je vous redonne des nouvelles

Retour : Total échec de ma tentative:-)

Cela dit, jusqu'à ce qu'une solution correcte soit trouvée, je fais de l'artisanat.

En effet, dans l'une des deux feuilles je renomme temporairement l'entête des deux colonnes en question avant de rouler la recherche.

Je leur redonne leur nom original après le traitement de la suppression des lignes doublons.

Ça vaut que ça vaut mais pour le moment ça fait la job :-)

Bonsoir,

pouvez vous fournir votre fichier ? Ce sera plus simple pour moi.
Sinon pas grave vu que votre solution fonctionne.

@ bientôt

LouReeD

bonjour LouReeD, Rosatom.ca,

si vous savez la ligne de l'entête de "TestB", alors il faut simplement ajuster cette ligne. Si l'entête est ligne 3, alors on remplace ce "1" par 4 (=3+1)? Si vous ne savez pas la ligne, mais si vous connaissez le contenu de l'entête, alors avec la 2eme ligne vous la savez ....

For i = 1 To UBound(b, 1)

r=application.match("Contenu de l'entête(à corriger par vous)", sh2.Range("C1:C" & lr2),0)

Merci à vous, je vais essayer cela et je vous reviens. Désolé pour le délai de réponse