Aide urgent a propos de VBA

Question

Bonjour


jai un grand problem avec VBA depuis une semaine jessaye de corriger je narrive pas


mon probleme 


jai deux feuilles excel une sappel "negatif" et lautre "liste_principal"


le code que je vais paster au dessous recherche les collons de la feuille "negatif" dans la feuille "liste_principal" il compare les enregistrements de la feuille "negatif" avec la feuille "liste_principal" et si une enregistrement de la feuille "negatif" nexiste pas dans la feuille "liste_principal" il ajout a la feuille "liste_principal"

ce que je veux cest le contraire
jai une liste de personnes avec leurs adresses disons 10.000 personnes est enregistres dans la feuille "liste_principal" et maintenant je veux supprimer certaines donc je creer une autre feuille qui sappel "negatif" et je met les enregistrements que je veux supprimer de la liste_principal 
 le macro vas supprimer automatiquement mes enregistrements qui sont dans la feuille "liste_principal".

Private Sub cbtStart_Click()
    Dim DerLigne            As Long
    Dim DerLigne2           As Long
    Dim L1                  As Long
    Dim L2                  As Long
    Dim Reste               As Long
    Dim LongFrame           As Long
    Dim CalculProgression   As Long
    Dim MonMot              As String
    Dim MotCompare          As String
    Dim MotExiste           As Boolean
    
LongFrame = Me.FrameProgress.Width
CalculProgression = 0


Application.ScreenUpdating = False


    Sheets("negatif").Select
DerLigne = Columns(1).Find("", [A1], , , xlByRows, xlNext).Row - 1


For L1 = DerLigne To 2 Step -1
    MonMot = Cells(L1, 1).Text
    
    CalculProgression = CalculProgression + 1
    LabelProgress.Width = LongFrame / (DerLigne - 1) * CalculProgression
    DoEvents


    For Reste = L1 - 1 To 2 Step -1
        MotCompare = Cells(Reste, 1).Text
        If MotCompare = MonMot Then
            Rows(Reste).Delete
        End If
    Next Reste
Next L1


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


Me.lblInfo.Caption = "Etap 2 / 2"
DerLigne = Columns(1).Find("", [A1], , , xlByRows, xlNext).Row - 1
CalculProgression = 0
LabelProgress.Width = 0


For L1 = DerLigne To 2 Step -1
        Sheets("negatif").Select
    MonMot = Cells(L1, 1).Text
    
    CalculProgression = CalculProgression + 1
    LabelProgress.Width = LongFrame / (DerLigne - 1) * CalculProgression
    DoEvents


        Sheets("liste_principal").Select
    DerLigne2 = Columns(1).Find("", [A1], , , xlByRows, xlNext).Row - 1
    MotExiste = True
    
    For L2 = 2 To DerLigne2
        MotCompare = Cells(L2, 1).Text
        If MotCompare = MonMot Then
            MotExiste = False
            Exit For
        End If
    Next L2


    If MotExiste = False Then
            Sheets("liste_principal").Select
        Range(Cells(L1, 1), Cells(L1, 11)).Copy
            Sheets("negatif").Select
        Range("A" & DerLigne2 + 1).Select
        ActiveSheet.Paste
    End If
Next L1


Application.ScreenUpdating = False
MsgBox "Operation termine avec succes !"
Unload Me


End Sub


Private Sub Image1_Click()


End Sub


Private Sub UserForm_Click()


End Sub

Ce code fait le contraire est ce que quelqun poura maider
je connais rien en VBA

Merci

cs_MPi · Answer

Essaie comme ceci

Pour le reste des détails comme la prograssion, je te laisse le soin de mettre ça en place


    Dim I As Long, nbLignes As Long

    Dim Recherche, Valeur

    

    'Activer la feuille "negatif" et calculer son nombre de lignes

    Sheets("negatif").Activate

    nbLignes = Cells.Find("*", Range("A1"), , , xlByRows, xlPrevious).Row

    

    'on passe chaque ligne

    For I = 1 To nbLignes

        Valeur = Sheets("negatif").Range("A" & I) 'à modifier

        'On recherche dans la colonne A de la feuille "liste_principal"

        'changer A:A pour la colonne à rechercher

        Set Recherche = Sheets("liste_principal").Columns("A:A").Find(Valeur)

        If Not Recherche Is Nothing Then  'Trouvé

           
Sheets("liste_principal").Rows(Range(Recherche.Address).Row).Delete

        End If

    Next

MPi

cs_sterkasor · Answer

Merci MPi
par contre je ne sais pas comment integrer ce code
je dois remplacer avec le code que jai coller au dessus?

merci

cs_MPi · Answer

Comme je t'ai dit, ce bout de code ne gère pas la progression (LabelProgress)


Crée une nouvelle Procédure, disons

Sub NettoyageListePrincipale()

'intègre le code que je t'ai donné

End sub


Le principe du code est de lire chaque ligne de negatif et de
rechercher (Find) la valeur en A dans la colonne A (A:A à modifier au
besoin) de la feuille liste_principal. Si la valeur est trouvée, la
ligne de liste_principal est effacée et on continue de lire la feuille
negatif.


J'ai essayé de te donner un code au plus simple pour t'aider à mieux
comprendre. Si j'y mets trop de détails, tu vas te perdre et
copier/coller sans rien comprendre... ce qui n'est pas le but. Une fois
que tu auras saisi le code, il sera toujours temps d'y rajouter des
fioritures comme la progression.


Si ça ne fait pas ton bonheur, tu fermes le classeur et tu ne sauvegardes pas

Et s'il y a quelque chose que tu ne comprends pas au bout de code, tu demandes.

MPi

cs_sterkasor · Answer

MPi je te remercie beaucoup
avec un peu de patient jai reussi a comprendre ton code
il marche tres bien exactement comme je voulais.

merci encore

cs_sterkasor · Answer

Je lai fais comme tu vois au dessous:

Private Sub cbtStart_Click()
    Dim DerLigne            As Long
    Dim DerLigne2           As Long
    Dim L1                  As Long
    Dim L2                  As Long
    Dim Reste               As Long
    Dim LongFrame           As Long
    Dim CalculProgression   As Long
    Dim MonMot              As String
    Dim MotCompare          As String
    Dim MotExiste           As Boolean
    
    Dim I As Long, nbLignes As Long
    Dim Recherche, Valeur
    
    'Activer la feuille "negatif" et calculer son nombre de lignes
    Sheets("negatif").Activate
    nbLignes = Cells.Find("*", Range("A1"), , , xlByRows, xlPrevious).Row
    
    'on passe chaque ligne
    For I = 1 To nbLignes
        Valeur = Sheets("negatif").Range("A" & I) 'à modifier
        'On recherche dans la colonne A de la feuille "liste_principal"
        'changer A:A pour la colonne à rechercher
        Set Recherche = Sheets("liste_principal").Columns("A:A").Find(Valeur)
        If Not Recherche Is Nothing Then  'Trouvé
            Sheets("liste_principal").Rows(Range(Recherche.Address).Row).Delete
        End If
    Next


Application.ScreenUpdating = False
MsgBox "Termine avec succes !"
Unload Me


End Sub


Private Sub Image1_Click()


End Sub


Private Sub UserForm_Click()


End Sub

cs_MPi · Answer

Good, il te resterait donc à intégrer la progression de ton Label et faire du ménage dans tes variables qui ne servent pas.


Comme la boucle For...Next est gourmande au niveau du processeur, on ne
peut pas simplement dire Label.Width=XYZ, il faut aussi mettre DoEvents
qui passera la main au système et permettra l'affichage raffraîchi du
Label.


Private Sub cbtStart_Click()

    Dim I As Long, nbLignes As Long

    Dim Recherche, Valeur

    Dim Ratio as Integer

    

    'Activer la feuille "negatif" et calculer son nombre de lignes

    Sheets("negatif").Activate

    nbLignes = Cells.Find("*", Range("A1"), , , xlByRows, xlPrevious).Row

    
'Si le Label de progression est invisible au départ

    LabelProgression.Visible = True

    'on passe chaque ligne

    For I = 1 To nbLignes

        'Modifier 500 par la longueur finale désirée du Label

        Ratio = (I / nbLignes) * 500

        Valeur = Sheets("negatif").Range("A" & I) 'à modifier

        'On recherche dans la colonne A de la feuille "liste_principal"

        'changer A:A pour la colonne à rechercher

        Set Recherche = Sheets("liste_principal").Columns("A:A").Find(Valeur)

        If Not Recherche Is Nothing Then  'Trouvé

           
Sheets("liste_principal").Rows(Range(Recherche.Address).Row).Delete

        End If

        LabelProgress.Width = Ratio

        DoEvents

    Next
    

    LabelProgression.Visible = False
Application.ScreenUpdating = True  ' le remettre à True à la fin
MsgBox "Terminé avec succès !"
Unload Me

End Sub

MPi

Aide urgent a propos de VBA

6 réponses

Votre réponse

Discussions similaires