[VB pour Excel 2010] Fusion, suppression, doublons,..

Résolu
guigs.pro -  
guigs.pro Messages postés 8 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour,

Je souhaite faire un traitement sur deux fichiers excels.
Le premier consisterait à fusionner les deux fichiers dans un seul dans une feuille.
J'ai donc fait une macro qui (à priori) fonctionne.
Par contre le deuxième intérêt serait de repérer les adresses en double et de les supprimer de ce fichier (donc les supprimer deux fois, pas garder une adresse comme avec l'option "supprimer les doublons").
J'ai donc fait la macro ci-dessous mais je ne comprends pas plusieurs choses :
.

Est-ce que lorsque l'on fait "ActiveCell.EntireRow.Delete", la ligne du dessus est automatiquement sélectionnée puisque l'on a supprimé la ligne ?
Est-ce que "ActiveCell.Select" ou "ActiveCell.Offset(1,0).Select" garde la sélection sur une seule colonne et ne garde pas en mémoire la précédente ?
.

Mon code ne marche pas et je ne comprends pas bien l'erreur.
Voici le code :
.
. 

Private Sub Workbook_Open()
MaCellule = InputBox("Veuillez saisir l'adresse de la 1ere cellule à comparer") 'récupère l'adresse de la cellule dans une variable MaCellule
Range(MaCellule).Select 'sélectionne la cellule indiquée
ActiveCell.CurrentRegion.Sort Key1:=Range(MaCellule), Order1:=xlAscending, Header:=xlYes 'trie le tableau de cette cellule
 
i = 0
 
donnee1 = ActiveCell.Value 'mémorise le contenu de la cellule et l'affecte à donnée 1
donnee2 = ActiveCell.Address 'mémorisation de la première ligne afin de pouvoir y revenir et la supprimer en cas de doublon
ActiveCell.Offset(1, 0).Select
i = i + 1
 
a = 0
 
While Not IsEmpty(ActiveCell.Value)
'tant que la cellule n'est pas vide
 
If (ActiveCell.Value = donnee1) Then
ActiveCell.EntireRow.Delete
'ActiveCell.Delete
a = 0
'Range(ActiveCell).FindPrevious.Select
 
Range(donnee2).Select
 
'Do While a < i
'ActiveCell.Offset(-1, 0).Select
'a = a + 1
'Loop
 
' Je sélectionne la première cellule qui contenait la donnée
ActiveCell.EntireRow.Delete
' commenté ActiveCell.Offset(-1, 0).Select
'remonte d'une ligne
' en commentaires ActiveCell.EntireRow.Delete
' commenté ActiveCell.Offset(1, 0).Select
' Fin ligne ajoutée
 
i = 0
 
donnee1 = ActiveCell.Value
donnee2 = ActiveCell.Address
 
ActiveCell.Offset(1, 0).Select
i = i + 1
' Je descends d'une ligne
 
ElseIf (ActiveCell.Value = "") And (donnee1 <> "") Then
ActiveCell.Offset(1, 0).Select
i = i + 1
 
Else
ActiveCell.Offset(1, 0).Select
i = i + 1
 
End If
 
Wend
 
End Sub


Merci d'avance,

7 réponses

  1.
    eriiic Messages postés 24581 Date d'inscription   Statut Contributeur Dernière intervention   7 281
     
    Bonjour, 

    Sub suppEmail()
    Dim derlig As Long, nb_email, i As Long
    Columns("B:B").Insert Shift:=xlToRight
    derlig = Cells(Rows.Count, "A").End(xlUp).Row
    Application.ScreenUpdating = False
    [B2].Resize(derlig - 1, 1).FormulaLocal = "=NB.SI(A:A;A2)"
    nb_email = [B1].Resize(derlig, 1)
    Columns(2).Delete
    For i = UBound(nb_email) To 2 Step -1
        If nb_email(i, 1) > 1 Then Rows(i).Delete
    Next i
    Application.ScreenUpdating = True
End Sub

    eric

    Jamais tu ne répondras à un mp non sollicité...
    Bon, ça c'est fait.
    1
  2. eriiic Messages postés 24581 Date d'inscription   Statut Contributeur Dernière intervention   7 281
     
    Bonjour,

    ton code n'est pas orthodoxe et est difficile à lire, pas indenté, je ne l'ai donc pas trop regardé...
    Le principe lorsque tu supprimes des lignes est de faire une boucle à l'envers : démarrer de la dernière ligne et remonter.
    Sinon si tu supprimes la ligne 5, la 6 devient la 5 est n'est pas vue si tu n'en tiens pas compte dans ta boucle.

    eric

    Jamais tu ne répondras à un mp non sollicité...
    Bon, ça c'est fait.
    0
  3. guigs.pro Messages postés 8 Date d'inscription   Statut Membre Dernière intervention  
     
    Bonjour,
    Merci pour la réponse.

    Si je comprends bien, lorsque je fais un ActiveCell.EntireRow.Delete, je n'ai pas besoin de faire le OffSet mais simplement un ActiveCell.Select() pour prendre en compte la ligne du dessous qui est devenu la cellule active ?

    Je remets le code un peu mieux organisé.
    Désolé, l'indentation n'est pas prise en compte dans les messages de ce forum :/ 

    Private Sub Workbook_Open()
MaCellule = InputBox("Veuillez saisir l'adresse de la 1ere cellule à comparer") 'récupère l'adresse de la cellule dans une variable MaCellule
Range(MaCellule).Select 
ActiveCell.CurrentRegion.Sort Key1:=Range(MaCellule), Order1:=xlAscending, Header:=xlYes  

i = 0 

donnee1 = ActiveCell.Value 'mémorise le contenu de la cellule et l'affecte à donnée 1
donnee2 = ActiveCell.Address 'mémorisation de la première ligne afin de pouvoir y revenir et la supprimer en cas de doublon
ActiveCell.Offset(1, 0).Select
i = i + 1
 
a = 0 
    While Not IsEmpty(ActiveCell.Value)
'tant que la cellule n'est pas vide 
               If (ActiveCell.Value = donnee1) Then
                                           ActiveCell.EntireRow.Delete
                                            a = 0 
                                           Range(donnee2).Select 
' Je sélectionne la première cellule qui contenait la donnée
                                     
                                            ActiveCell.EntireRow.Delete 
                                             i = 0
 
                                             donnee1 = ActiveCell.Value
                                             donnee2 = ActiveCell.Address
 
                                             ActiveCell.Offset(1, 0).Select
                                              i = i + 1                                    
         ' Je descends d'une ligne 
                                 
                  ElseIf (ActiveCell.Value = "") And (donnee1 <> "") Then
                                        ActiveCell.Offset(1, 0).Select
                                             i = i + 1
 
                   Else
                                         ActiveCell.Offset(1, 0).Select
                                              i = i + 1
 
                    End If
 
          Wend

End Sub
    0
    1. eriiic Messages postés 24581 Date d'inscription   Statut Contributeur Dernière intervention   7 281
       
      Le mieux serait quand même un petit fichier exemple.
      Déposer le fichier xls (réduit au nécessaire et anonymisé) sur cjoint.com et coller ici le lien fourni.

      eric
      0
  4. guigs.pro Messages postés 8 Date d'inscription   Statut Membre Dernière intervention  
     
    Finalement quelqu'un m'a aidé sur un autre forum et a résolu le problème de suppression (les adresses en doubles sont supprimées toutes les deux), mais j'ai un nouveau problème, c'est que les adresses uniques sont aussi supprimées et là je sèche :/
    Auriez-vous une idée ? Merdi, voici le code : 

    Sub FindNext()
Dim tableau() As Variant
With Worksheets(1).Range("A1").EntireColumn
 
        valeur = Range("A1")
        Set c = .Find(valeur, LookIn:=xlValues)
        If Not c Is Nothing Then
            firstAddress = c.Address
                End If
                 Do
                adresse = adresse & c.Address & ","
                Set c = .FindNext(c)
              Loop While Not c Is Nothing And c.Address <> firstAddress
 
  adresse = Left(adresse, Len(adresse) - 1)
 End With
Sheets(1).Range(adresse).EntireRow.Delete
End Sub
    0

  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. eriiic Messages postés 24581 Date d'inscription   Statut Contributeur Dernière intervention   7 281
     
    On va attendre que tu aies la réponse sur l'autre forum.
    Ca ne sert à rien d'être plusieurs à chercher la même chose.
    eric
    0
  7. guigs.pro Messages postés 8 Date d'inscription   Statut Membre Dernière intervention  
     
    Justement ils n'ont pas la réponse, c'est pour ça que je poste ici.
    Comme il n'y a qu'une personne qui répond et qui m'aide sur l'autre forum, peut-être qu'ici avec un regard neuf quelqu'un me dira que qu'en fait c'est tout bête il suffit de rajouter ça ou ça..
    0
  8. guigs.pro Messages postés 8 Date d'inscription   Statut Membre Dernière intervention  
     
    Bonjour,

    Merci pour ce code !!!!!
    Il fonctionne parfaitement.

    Entre temps j'avais aussi trouvé une solution avec le code suivant pour ceux que ça intéresse (néanmoins le code d'eric a l'air de mieux fonctionner puisque le mien gère une seule cellule vide) : 

    Sub FindNext()
Dim tableau() As Variant
With Worksheets(1).Range("A1").EntireColumn
 
        Range("A1").Select
        
        Do
        
        valeur = ActiveCell.Value
        
        Set c = .Find(valeur, LookIn:=xlValues)
        If Not c Is Nothing Then
            firstaddress = c.Address
            End If
            Do
                 Set c = .FindNext(c)
              If Not c Is Nothing Then
                       adresse = adresse & c.Address & ","
             End If
              Loop While Not c Is Nothing And c.Address <> firstaddress
        
        If adresse <> "" And Len(adresse) > 8 Then
 adresse = Left(adresse, Len(adresse) - 1)
 'adresse = adresse & Range(firstaddress).Address
.Range(adresse).EntireRow.Delete
        
        adresse = ""
        ActiveCell.Offset(1, 0).Select
        
        Else:
        adresse = ""
        ActiveCell.Offset(1, 0).Select
              
        End If
              
        Loop While ActiveCell.Value <> ""
  
  End With

End Sub
    0

Discussions similaires

Reactiver la fusion des cellules, tableau exc
chector10 -
chector10 -

38 réponses