Comparer 2 feuilles excel [VBA]

Résolu

binos359 Messages postés 2 Date d'inscription Statut Membre Dernière intervention -
binos359 Messages postés 2 Date d'inscription Statut Membre Dernière intervention - 8 févr. 2015 à 21:46

Bonjour,

Je me permets de solliciter votre aide car je bloque sur la programmation VBA pour un projet.
Ce que j'ai:

2 feuilles excel avec des listes, le numéro d'identification est unique.

Ce que je voudrai:
-comparer la feuille 2 avec la feuille 1
-si il y a correspondance on supprime la ligne
-Si l'objet feuille2 ne se retrouve pas dans feuille1 on copie la ligne dans une autre page
-si quelque chose de la feuille 1 n'est pas sur la feuille 2 on supprime la ligne aussi

Comment modifier ce code pour y parvenir?
(pour l'instant celui ci supprime uniquement les doublons présents dans une même page et par conséquent garde les infos de la feuille 1 qui ne sont pas présentes dans la feuille 2)

Merci beaucoup :)

Sub doublons ()

choix = InputBox("Choisissez l'action qui vous intéresse :" & Chr(10) & Chr(10) & "1. Colorer les doublons (colorer la cellule)" & Chr(10) & "2. Colorer les doublons (colorer la ligne entière)" & Chr(10) & "3. Effacer les doublons (en laissant la ligne vide)" & Chr(10) & "4. Supprimer les doublons (ligne entière)" & Chr(10) & "5. Supprimer les lignes vides" & Chr(10) & Chr(10) & "Entrez le n° de l'action et cliquez sur OK :")
If choix = "" Then Exit Sub

choix2 = ""
If choix = 1 Or choix = 2 Or choix = 3 Or choix = 4 Then choix2 = InputBox("Entrez la lettre de la colonne où les doublons doivent être recherchés : »)
If choix = 5 Then choix2 = InputBox("Entrez la lettre de la colonne à prendre en compte (si la cellule de cette colonne est vide, la ligne sera supprimée) :")
If choix2 = "" Then Exit Sub

Application.ScreenUpdating = False
test = Timer

der_ligne = Range(choix2 & "65000").End(xlUp).Row

Dim tab_cells()
ReDim tab_cells(der_ligne - 1)

For ligne = 1 To der_ligne
tab_cells(ligne - 1) = Range(choix2 & ligne)
Next

nb = 0
If choix = 4 Or choix = 5 Then compteur = 0

For ligne = 1 To der_ligne
contenu = tab_cells(ligne - 1)

If (choix = 1 Or choix = 2) And contenu <> "" Then 'Colorer doublons
For i = 1 To der_ligne
If contenu = tab_cells(i - 1) And ligne <> i Then 'Si doublon
nb = nb + 1
If choix = 1 Then
Range(choix2 & ligne).Interior.ColorIndex = 3
Else
Range(ligne & ":" & ligne).Interior.ColorIndex = 3
End If
Exit For
End If
Next
End If

If (choix = 3 Or choix = 4) And ligne > 1 And contenu <> "" Then 'Effacer/supprimer doublons
For i = 1 To ligne - 1
If contenu = tab_cells(i - 1) Then 'Si doublon
nb = nb + 1
If choix = 3 Then
Range(ligne & ":" & ligne).ClearContents
Else
Range(ligne + compteur & ":" & ligne + compteur).Delete
compteur = compteur - 1
End If
Exit For
End If
Next
End If

If choix = 5 And contenu = "" Then 'Lignes vides
Range(ligne + compteur & ":" & ligne + compteur).Delete
compteur = compteur - 1
nb = nb + 1
End If
Next

res_test = Format(Timer - test, "0" & Application.DecimalSeparator & "000")
Application.ScreenUpdating = True

If nb = 0 And choix = 5 Then
dd = MsgBox("Aucune ligne vide trouvée ...", 64, "Résultat")
ElseIf nb = 0 Then
dd = MsgBox("Aucun doublon trouvé dans la colonnne " & UCase(choix2) & " ...", 64, "Résultat")
ElseIf choix = 5 Then
dd = MsgBox(nb & " lignes supprimées (en " & res_test & " secondes)", 64, "Résultat")
ElseIf choix = 4 Then
dd = MsgBox(nb & " doublons supprimés (en " & res_test & " secondes)", 64, "Résultat")
ElseIf choix = 3 Then
dd = MsgBox(nb & " doublons effacés (en " & res_test & " secondes)", 64, "Résultat")
Else
dd = MsgBox(nb & " doublons passés en rouge (en " & res_test & " secondes)", 64, "Résultat")
End If

End Sub

A voir également:

Comparer deux feuilles excel et afficher différence vba
Word et excel gratuit - Guide
Liste déroulante excel - Guide
Nombre de jours entre deux dates excel - Guide
Différence entre tcp et udp - Guide
Si et excel - Guide

2 réponses

Réponse 1 / 2

cs_Le Pivert Messages postés 7904 Date d'inscription Statut Contributeur Dernière intervention 729

Bonjour,

Le code que tu as trouvé sur le net compare 2 colonnes situées sur la même feuille

Voici un exemple avec 2 colonnes situées dans 2 feuilles à adapter:

Mettre dans une UserForm 5 boutons avec ce code:

Option Explicit
Dim der_ligne, cel1, cel2, li
'colorie doublons
Private Sub CommandButton1_Click()
der_ligne = Range("A" & "65000").End(xlUp).Row
For Each cel1 In Sheets("Feuil1").Range("A1:A" & der_ligne)
    For Each cel2 In Sheets("Feuil2").Range("A1:A" & der_ligne)
      If cel1 = cel2 Then
        li = li + 1
        cel1.Interior.ColorIndex = 3
        cel2.Interior.ColorIndex = 3
      End If
    Next
  Next
End Sub
'rétablie couleur initiale
Private Sub CommandButton2_Click()
der_ligne = Range("A" & "65000").End(xlUp).Row
Sheets("Feuil1").Range("A1:A" & der_ligne).Interior.ColorIndex = xlNone
Sheets("Feuil2").Range("A1:A" & der_ligne).Interior.ColorIndex = xlNone
End Sub
'effacer contenu la ligne doublon feuil2
Private Sub CommandButton3_Click()
der_ligne = Range("A" & "65000").End(xlUp).Row
For Each cel1 In Sheets("Feuil1").Range("A1:A" & der_ligne)
    For Each cel2 In Sheets("Feuil2").Range("A1:A" & der_ligne)
      If cel1 = cel2 Then
        li = li + 1
     cel2.ClearContents
      End If
    Next
  Next
End Sub
'copier ligne sans doublons dans feuil3
Private Sub CommandButton4_Click()
der_ligne = Range("A" & "65000").End(xlUp).Row
For Each cel1 In Sheets("Feuil1").Range("A1:A" & der_ligne)
    For Each cel2 In Sheets("Feuil2").Range("A1:A" & der_ligne)
      If cel1 = cel2 Then
        li = li + 1
        cel1.Interior.ColorIndex = 3
       End If
        Next
  Next
   li = 0
  For Each cel1 In Sheets("Feuil1").Range("A1:A" & der_ligne)
 If cel1.Interior.ColorIndex = xlNone Then
    li = li + 1
    Sheets("Feuil3").Select
    Range("A" & li).Value = cel1
    End If
        Next
Sheets("Feuil1").Range("A1:A" & der_ligne).Interior.ColorIndex = xlNone
 End Sub
'supprimer la ligne doublon feuil2
Private Sub CommandButton5_Click()
der_ligne = Range("A" & "65000").End(xlUp).Row
For Each cel1 In Sheets("Feuil1").Range("A1:A" & der_ligne)
    For Each cel2 In Sheets("Feuil2").Range("A1:A" & der_ligne)
      If cel1 = cel2 Then
        li = li + 1
     cel2.Delete
      End If
    Next
  Next
End Sub
Private Sub UserForm_Initialize()
CommandButton1.Caption = "Colorier doublons"
CommandButton2.Caption = "Rétablir couleurs"
CommandButton3.Caption = "Effacer lignes"
CommandButton4.Caption = "Copier lignes"
CommandButton5.Caption = "Supprimer lignes"
End Sub

Tu peux adapter des inputBox avec les codes qui sont dans les boutons en en faisant des macros

Discussions similaires

Macro enregistrer en PDF

VBA : Copier valeur de cellules dans une autre feuilles

Verrouiller feuille Excel sauf pour macro

Copier/coller d'un classeur à un autre

Macro pour enregistrer une feuille excel d'un classeur

boucle copier coller ligne vers une feuille si condition valeur

Votre réponse

Discussions similaires