IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Macro de comparaison d'une cellule d'une feuille avec une cellule d'une autre feuille. [XL-2002]


Sujet :

Macros et VBA Excel

  1. #1
    Membre à l'essai
    Inscrit en
    mai 2010
    Messages
    14
    Détails du profil
    Informations forums :
    Inscription : mai 2010
    Messages : 14
    Points : 12
    Points
    12
    Par défaut Macro de comparaison d'une cellule d'une feuille avec une cellule d'une autre feuille.
    Bonjour à tous,

    Voila je débute dans VBA (8 heures de cours intensifs), j’ai quelque notions mais pas de pratique.

    J’ai un fichier .xls contenant 2 feuilles:

    • Une première feuille « Tabelle1 » dite référence contenant plusieurs items uniques (environs 200), Colonnes de Réf “C2”.
    • Une deuxième feuille « Tabelle2 » dite Data contenant plusieurs items (environs 30000) avec possibilité de doublons et beaucoup non présents dans la feuille de Référence (Tabelle 1), colonnes de Réf “E2”.

    Les items dans "C2" et "E2" sont des valeurs numériques sur 5 digits.

    Ce qui m’intéresse serait de faire une macro qui supprime toutes les lignes de la Feuil2 qui ne sont pas présents dans la Tabelle1. j'aimerais aussi conservé même les doublons qui sont présents dans la Tabelle1.

    Si quelqu'un pouvait m'aider à réaliser cette macro, je suis preneur de toutes informations.


    J’ai commencé par ceci mais je patine totalement :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    Sub Supprime_loop_non_reseau()
     
    Dim loop_Reseau As String
    Dim loop_Ref As String
    Dim Mycheck
    Dim Rng_Reseau As Range
    Dim Rng_Ref As Range
     
    Workbooks("testloop.xls").Sheets("Tabelle2").Activate
     
    Set Rng_Reseau = Range("c2").CurrentRegion
    Rng_Reseau.Value = loop_Reseau
     
    Workbooks("testloop.xls").Sheets("Tabelle1").Activate
    Set Rng_Ref = Range("e2")
     
    While ActiveCell.Value <> ""
     
        Mycheck = loop_Reseau Like loop_Ref
     
    Wend
     
    End Sub

  2. #2
    Membre régulier
    Profil pro
    Inscrit en
    mai 2010
    Messages
    97
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : mai 2010
    Messages : 97
    Points : 121
    Points
    121
    Par défaut
    Bonjour steelydan,

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    Dim i as Long, j as Byte
    Dim Ws as WorkSheet
    Dim Wc as WorkSheet
    Dim RefTrouvee as Boolean
     
    Set Ws = Workbooks("testloop.xls").Sheets("Tabelle2")
    Set Wc = Workbooks("testloop.xls").Sheets("Tabelle1")
     
    i = 1
    Do While Ws.Range("E2").Cells(i, 1) <> ""
        j = 1
        RefTrouvee = False
        Do While Wc.Range("C2").Cells(j, 1) <> "" and RefTrouvee = False
            If Ws.Range("E2").Cells(i,1) = Wc.Range("C2").Cells(j, 1) Then
                RefTrouvee = True
            End If
            j = j + 1
        Loop
        If RefTrouvee = False Then
            Ws.Rows(i+1).Delete
        Else
            i = i + 1
        End If
    Loop
    Je n'ai pas testé le code car je n'ai pas tes données, mais dis moi si tu as une erreur et si ca fait ce que tu veux.

    En gros, de ce que j'ai compris, si une référence de la feuille 2 est présente dans la feuille 1, on la garde, sinon on supprime la ligne dans la feuille 2.

  3. #3
    Membre à l'essai
    Inscrit en
    mai 2010
    Messages
    14
    Détails du profil
    Informations forums :
    Inscription : mai 2010
    Messages : 14
    Points : 12
    Points
    12
    Par défaut
    Salut Yoyo,

    J'ai lancé la macro la premiere fois sur une copie du fichier cela a supprimé toute les lignes sur tabellle 2.

    j'ai effectué une petite modif ensuite, en inversant partout le E2 par C2 et vice et versa.

    Et la Nickel super tout fonctionne à merveille, t'es un crack.

    Je te remercie enormément.

    Pour infos pour environs 30000 lignes et 244 en Ref, cela a duré environs 10 min.


    Je m'appelle karim j'ai omis de l'indiquer.

    Merci encore.

  4. #4
    Membre régulier
    Profil pro
    Inscrit en
    mai 2010
    Messages
    97
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : mai 2010
    Messages : 97
    Points : 121
    Points
    121
    Par défaut
    Salut Karim,

    10 minutes c'est long... Je sais pas si tu dois refaire cà à l'avenir mais tu peux ajouter

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    Application.ScreenUpdating = False
    au tout début de la macro pour gagner du temps d'exécution

    A la fin de la macro, je te conseille un

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    Application.ScreenUpdating = True
    Call MsgBox("Opérations réalisées avec succès", vbOkOnly + vbInformation, "Traitement terminé")
    Afin de savoir quand ton traitement est terminé.

    Autre précision :

    Si tu as moins de 32768 lignes à traiter, alors i peut être un entier au lieu d'un Long

    De plus, si tu dépasses 255 réfs dans ta feuille Tabelle1, alors j devra obligatoirement être un entier (sinon tu vas avoir une erreur à l'exécution) et non un Byte

    Un Byte ne peut dépasser 255 et un Integer ne peut dépasser 32768.

  5. #5
    Expert éminent sénior Avatar de mercatog
    Homme Profil pro
    Inscrit en
    juillet 2008
    Messages
    9 432
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations forums :
    Inscription : juillet 2008
    Messages : 9 432
    Points : 31 861
    Points
    31 861
    Par défaut
    Ma proposition plus rapide
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    Sub SupprAbs()
    Dim LastLig1 As Long, LastLig2 As Long, i As Long
    Dim c As Range
     
    Application.ScreenUpdating = False
    LastLig2 = Sheets("Tabelle2").Cells(Rows.Count, "C").End(xlUp).Row
    If LastLig2 > 2 Then
        With Sheets("Tabelle1")
            LastLig1 = .Cells(Rows.Count, "E").End(xlUp).Row
            If LastLig1 > 2 Then
                For i = LastLig1 To 2 Step -1
                    Set c = Sheets("Tabelle2").Range("C2:C" & LastLig2).Find(What:=.Range("E" & i).Value, LookIn:=xlValues, Lookat:=xlWhole)
                    If c Is Nothing Then .Rows(i).Delete
                Next i
            End If
        End With
    End If
    End Sub
    Pour les suppressions de lignes, il est plus facile de commencer du bas et remonter
    Cordialement.
    J'utilise toujours le point comme séparateur décimal dans mes tests.

  6. #6
    Membre à l'essai
    Inscrit en
    mai 2010
    Messages
    14
    Détails du profil
    Informations forums :
    Inscription : mai 2010
    Messages : 14
    Points : 12
    Points
    12
    Par défaut
    Salut Lionel,

    Nickel Lionel ,

    Comme tu peux le voir ci-dessous petite inversion avec Tabelle1 et 2 , et champs E et C.

    Après modifs elle s'execute en moins d'une minute, Tip Top !

    Une petite question si ton temps te le permets comment pourrait-on traduire dans un langage simple la ligne de commande suivante, quelle est instruction qui fait la comparaison entre E et C :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    Set c = Sheets("Tabelle1").Range("E2:E" & LastLig2).Find(What:=.Range("C" & i).Value, LookIn:=xlValues, Lookat:=xlWhole)
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    Sub SupprAbs()
    Dim LastLig1 As Long, LastLig2 As Long, i As Long
    Dim c As Range
     
    Application.ScreenUpdating = False
    LastLig1 = Sheets("Tabelle1").Cells(Rows.Count, "C").End(xlUp).Row
    If LastLig1 > 2 Then
        With Sheets("Tabelle2")
            LastLig2 = .Cells(Rows.Count, "E").End(xlUp).Row
            If LastLig2 > 2 Then
                For i = LastLig2 To 2 Step -1
                    Set c = Sheets("Tabelle1").Range("E2:E" & LastLig2).Find(What:=.Range("C" & i).Value, LookIn:=xlValues, Lookat:=xlWhole)
                    If c Is Nothing Then .Rows(i).Delete
                Next i
            End If
        End With
    End If
    End Sub
    Merci à toi Mercatog...
    Je suis un peu perdu avec ces messages.
    Merci en tous les cas Messieurs.

  7. #7
    Expert éminent sénior Avatar de mercatog
    Homme Profil pro
    Inscrit en
    juillet 2008
    Messages
    9 432
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations forums :
    Inscription : juillet 2008
    Messages : 9 432
    Points : 31 861
    Points
    31 861
    Par défaut
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    Set c = Sheets("Feuil1").Range("E2:E100").Find(What:=Mot, LookIn:=xlValues, Lookat:=xlWhole)
    Dans la plage E2:E100 de la feuille Feuil1 on cherche Mot.
    Pour les paramètres lookin i lookat (il y en a d'autre) fait un F1 sur le mot find
    Cordialement.
    J'utilise toujours le point comme séparateur décimal dans mes tests.

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. [XL-2010] Copier plage de cellules vers une autre feuille selon un critère dans une boucle
    Par klash384 dans le forum Macros et VBA Excel
    Réponses: 5
    Dernier message: 12/01/2015, 17h53
  2. Réponses: 8
    Dernier message: 22/04/2014, 09h41
  3. Réponses: 6
    Dernier message: 06/01/2014, 21h08
  4. Réponses: 1
    Dernier message: 05/09/2007, 12h47
  5. Réponses: 9
    Dernier message: 14/01/2007, 17h09

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo