Discussion :

[sterkasor]

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 "ana_liste"

le code que je vais paster au dessous recherche les collons de la feuille "negatif" dans la feuille "ana_liste" il compare les enregistrements de la feuille "negatif" avec la feuille "ana_liste" et si une enregistrement de la feuille "negatif" nexiste pas dans la feuille "ana_liste" il ajout a la feuille "ana_liste"

ce que je veux cest le contraire
jai une liste de personnes avec leurs adresses disons 10.000 personnes est enregistres dans la feuille "ana_liste" 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 ana_liste
le macro vas supprimer automatiquement mes enregistrements qui sont dans la feuille "ana_liste".

ma feuille "negatif" contient seulement le nom et le prenom A,B
et ma feuille "ana_liste" contient nom,prenom,adresse1,adresse2, etc....

jai essaye beaucoup de code mais aucuns marche correctement, souvent il saute les lignes, il nefface pas certaines ligne quil doit effacer

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
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
 
Private Sub cbtStart_Click()
    Dim I As Long, nbLignes As Long, nbItems 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
 
    'on lit chaque ligne de negatif
    For I = 2 To nbLignes
        'à chaque changement de ligne, la valeur de Ratio augmente
        Ratio = (I / nbLignes) * FrameProgress.Width
 
        'lecture de la valeur à rechercher
        Valeur = Sheets("negatif").Range("A" & I)
 
        'On recherche dans la colonne A de la feuille "ana_liste"
        Set Recherche = Sheets("ana_liste").Columns("A:A").Find(Valeur)
        If Not Recherche Is Nothing Then
            'on a donc trouvé le nom
            'il faut vérifier si le prénom et l'adresse1 sont identiques
            If Sheets("ana_liste").Range(Recherche.Address).Offset(0, 1) = Range("A" & I).Offset(0, 1) _
                And Sheets("ana_liste").Range(Recherche.Address).Offset(0, 2) = Range("A" & I).Offset(0, 2) _
                And Sheets("ana_liste").Range(Recherche.Address).Offset(0, 3) = Range("A" & I).Offset(0, 3) Then
 
                'Effacement de la ligne
                Sheets("ana_liste").Rows(Range(Recherche.Address).Row).Delete
                'Accumuler le nombre de lignes effacées
                nbItems = nbItems + 1
            End If
        End If
 
        'ajustement de la barre de progression
        LabelProgress.Width = Ratio
        DoEvents
    Next
 
    MsgBox "Première partie terminée avec succès !" & vbCrLf & _
            nbItems & " lignes ont été effacées de «ana_liste»"
 
'*****************************************************************************************
'Effacer les doublons de la feuille negatif
    lblInfo.Caption = "Étape 2 / 2"
    nbItems = 0  'réinitialise la variable compteur
    Sheets("negatif").Activate
    nbLignes = Cells.Find("*", Range("A1"), , , xlByRows, xlPrevious).Row
 
    'Tri de la feuille selon 3 critères: Nom, Prénom et Adresse1
    Cells.Select
    Selection.Sort key1:=Range("A1"), key2:=Range("B1"), key3:=Range("C1"), header:=xlYes
    Range("A1").Select  'enlève la sélection
 
    'Lecture de chaque ligne en partant de la fin
    For I = nbLignes To 2 Step -1
        'Si les nom, prénom et adresse sont identiques aux précédents, il y a doublon
        If Range("A" & I) = Range("A" & I - 1) And _
            Range("B" & I) = Range("B" & I - 1) And _
            Range("C" & I) = Range("C" & I - 1) Then
 
        Rows(I).Delete
        nbItems = nbItems + 1  'calcul du nombre de doublons
        End If
    Next
 
    Application.ScreenUpdating = True
    MsgBox "Deuxième partie terminée avec succès !" & vbCrLf & _
            nbItems & " lignes-doublons ont été effacées de «negatif»"
    Unload Me
 
End Sub

Ce code fait le contraire est ce que quelqun poura maider
je connais rien en VBA

Merci

[ced600]

En fait si cela ne marche pas correctement c'est certainement parce que l'algo que tu utilises n'est pas bon. Refléchis à comment tu ferais à la main, puis code ce raisonnement, et la tu auras quelque chose qui marche pour tous les cas. Sauf bien sur si tu n'y as pas rfléchis assez longtemps .
Un des algos le plus simple pour ton cas est : pour chaque element de ta feuille ana_principal, tu le compare à chaque element de ta feuille negatif, et lorsque tu trouves un élément identique alors tu le supprime de la feuille ana_principal. C'est pas rapide en temps de traitement, mais si tu arrives déja à faire ça alors tu pourras ensuite faire de l'optimisation.
Ha et il est inutile de connaître un langage de programmation pour faire un algo.
Une dernière chose, je ne vois pas comment le code que tu as posté ajoute des éléments avec ça dans le code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
 
'Effacement de la ligne
Sheets("ana_liste").Rows(Range(Recherche.Address).Row).Delete

[sterkasor]

En fait si cela ne marche pas correctement c'est certainement parce que l'algo que tu utilises n'est pas bon. Refléchis à comment tu ferais à la main, puis code ce raisonnement, et la tu auras quelque chose qui marche pour tous les cas. Sauf bien sur si tu n'y as pas rfléchis assez longtemps .
Un des algos le plus simple pour ton cas est : pour chaque element de ta feuille ana_principal, tu le compare à chaque element de ta feuille negatif, et lorsque tu trouves un élément identique alors tu le supprime de la feuille ana_principal. C'est pas rapide en temps de traitement, mais si tu arrives déja à faire ça alors tu pourras ensuite faire de l'optimisation.
Ha et il est inutile de connaître un langage de programmation pour faire un algo.
Une dernière chose, je ne vois pas comment le code que tu as posté ajoute des éléments avec ça dans le code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
 
'Effacement de la ligne
Sheets("ana_liste").Rows(Range(Recherche.Address).Row).Delete

salut cedric600
je connais rien en programmation ce code cest pas moi qui la ecrit
mais comment ca cest un probleme argo? cest quoi un argo?
je viens de corriger mon message, excuse
je suis tout pres de la suicide :S

[ced600]

Heu... Ce n'est pas que tu n'as jamais fait de VBA, je pense que tu n'as jamais fait de programmation. Bah va falloir prendre les tutoriaux et apprendre les base. Quand je parle d'algo, je parle d'algorithme. En gros c'est la description de ce que fait ton programme et comment il le fait. Exemple :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
SI Nombre = 5 ALORS
    Nombre = 5 + 1
SINON
    J'affiche Nombre
FIN SI

[sterkasor]

tout ce qui jai besoin cest la correction de ce macro car il ne marche pas comme il me faut, estceque tu peux corriger le probleme?

Heu... Ce n'est pas que tu n'as jamais fait de VBA, je pense que tu n'as jamais fait de programmation. Bah va falloir prendre les tutoriaux et apprendre les base. Quand je parle d'algo, je parle d'algorithme. En gros c'est la description de ce que fait ton programme et comment il le fait. Exemple :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
SI Nombre = 5 ALORS
    Nombre = 5 + 1
SINON
    J'affiche Nombre
FIN SI

[RLX]

Salut sterkasor,

juste une question,

Si c'est pas toi qui a écris le code et si tu n'y connais rien en VBA pourquoi essaye-tu de corriger le code, pourquoi tu laisse pas faire celui qui l'a écrit?