Discussion :

[liop49]

Bonjour,

J'en ai marre à cannard, rien ne marche dès que j'essaye qq chose


Voici mon pb, j'importe des données dans mon classeur et je voudrais éviter d'importer en doublons. J'ai donc laissé l'importation se faire et une fois faite alors je filtre mon en-tête via la date et s'il y a deux lignes pour une même date alors il faut effacer la dernière ligne.

Voici le code :

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
Dim Date_visite As String
 
   Range("B6553").End(xlUp).Select = Date_visite 'permet normalement de connaître la date de ligne importée
   Range("B5").Select
   Selection.AutoFilter Field:=1, Criteria1:=Date_visite 'je filtre le tableau avec la datre de la dernière importation
   ActiveCell.Offset(2, 0).Select 'je descend de 2 lignes
   valeur = ActiveCell.Value
 
   If Not IsEmpty(valeur) Then 'il y a une donnée sur la 2ième ligne donc la ligne importée est en doublons
        ActiveRow.Select 'selection de la ligne doublons
        Selection.Delete Shift:=xlUp ' suppression de la ligne doublons
        Range("B5").Select
 
        Else 'il n'y a pas de donnée sur la 2ième ligne donc pas de doublons
 
        End If

Il me mets objet requis sur

Code :

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

Range("B6553").End(xlUp).Select = Date_visite

QQ 1 peut-il m'orienter ?

Merci par avance

[DeaD78]

Bonjour,

Remplace

Code :

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

Range("B6553").End(xlUp).Select

par

Code :

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

Range("B6553").End(xlUp).Value

Je viens de faire le test, ça marche.

Allez, en selle (de cheval) pour la suite

EDIT : Ah, ça marche mais de travers, il te sort encore l'objet requis parfois. Attends, je vais avoir quelque chose de mieux pour toi, je le retrouve et je le poste.

[DeaD78]

Je mets ça dans un nouveau post histoire que ça ne soit pas trop fouilli.

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
Sub test()
 
Dim FL1 As Worksheet
Dim Valeur As Variant, c As Range
Dim NoLigne As Long, DerLig As Long
    Set FL1 = Worksheets("NomDeTaFeuille")
    NoLigne = 1 'Si les données commencent à la ligne 1
    Do
        If Not Cells(NoLigne, 2) = "" Then 'Colonne B
            Valeur = Cells(NoLigne, 2)
            Do
                With FL1.Range("B" & NoLigne + 1, [B65536].End(xlUp))
                    DerLig = 0
                    Set c = .Find(Valeur, LookIn:=xlValues, LookAt:=xlWhole)
                    If Not c Is Nothing Then
                        If c.Row > NoLigne Then
                            DerLig = c.Row
                            c.EntireRow.Delete
                        End If
                    End If
                    Set c = Nothing
                End With
            Loop While DerLig > NoLigne
        End If
        NoLigne = NoLigne + 1
    Loop While NoLigne < FL1.Range("B65536").End(xlUp).Row
 
End Sub

Voilà, ce code te vire les doublons colonne B. De plus, il est optimisé. Après, libre à toi de rajouter un filtre sur ta colonne.

Bonne chance !

[liop49]

Bonjour à tous et à Dead78,


Parfait ce code de la mort !!!!

Tu es parfait

Voici le code pour ceux qui veulent s'en inspirer.
Le principe est d'aller chercher des données précises dans des fichiers contenant un code client précis. S'il y a un fichier qui contient ce code client alors on récupére certaines données de la ligne ayant le code client et on les copie dans le fichier source.
La 2nd macro évite de copier des lignes déjà importées.

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
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
Public Sub Importe_Visite()
 
Dim CodeClient As String
 
CodeClient = Worksheets("Fiche client").Range("E3")
 
Const LookInFolder = "C:\Bordereau de visites\"
 Dim xlFichier As String 'fichier xls trouvé
 Dim ActionLigne As Long 'Ligne où doivent être copiées les données trouvées
 Dim xlClasseur As Workbook 'Classeur de recherche
 Dim xlFeuillet As Worksheet 'Feuillet de recherche
 Dim xlRange As Range  'Plage où le code client a été trouvé
 
 'Rechercher les fichiers xls du dossier
 xlFichier = Dir(LookInFolder & "*.xls")
 Do While xlFichier <> ""
'Ouvrir le classeur du fichier trouvé
   Set xlClasseur = Workbooks.Open(Filename:=LookInFolder & xlFichier, ReadOnly:=True)
'Pour chaque Feuillet du classeur
   For Each xlFeuillet In xlClasseur.Worksheets
'Récupérer la plage où CodeClient est trouvé
     Set xlRange = xlFeuillet.Range("A1:A65536").Find(CodeClient, , xlValues, xlWhole, xlByRows, xlNext, False, False)
'Si CodeClient a été trouvé alors récupéré les valeurs
    If Not xlRange Is Nothing Then
       With ThisWorkbook.Worksheets("Actions")
 
 
 
         ActionLigne = .Range("B65535").End(xlUp).Row + 1
         .Cells(ActionLigne, 2) = xlFeuillet.Range("G5")
         .Cells(ActionLigne, 3) = xlFeuillet.Cells(xlRange.Row, 2)
         .Cells(ActionLigne, 4) = xlFeuillet.Cells(xlRange.Row, 7)
         .Cells(ActionLigne, 5) = xlFeuillet.Cells(xlRange.Row, 8)
         .Cells(ActionLigne, 6) = xlFeuillet.Cells(xlRange.Row, 9)
         .Cells(ActionLigne, 7) = xlFeuillet.Cells(xlRange.Row, 10)
 
 
 
 
 
       End With
       Set xlRange = Nothing
    End If
   Next
   Set xlFeuillet = Nothing
   xlClasseur.Close
   Set xlClasseur = Nothing
   xlFichier = Dir
 
 
 
   verif_importation
 
 Loop
 
     'trier par date de visite
    Rows("6:6").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Sort Key1:=Range("B6"), Order1:=xlDescending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("A1").Select
 
End Sub
 
 
 
 
Sub verif_importation()
 
Dim FL1 As Worksheet
Dim Valeur As Variant, c As Range
Dim NoLigne As Long, DerLig As Long
    Set FL1 = Worksheets("Actions")
    NoLigne = 6 'Si les données commencent à la ligne 1
    Do
        If Not Cells(NoLigne, 2) = "" Then 'Colonne B
            Valeur = Cells(NoLigne, 2)
            Do
                With FL1.Range("B" & NoLigne + 1, [B65536].End(xlUp))
                    DerLig = 0
                    Set c = .Find(Valeur, LookIn:=xlValues, LookAt:=xlWhole)
                    If Not c Is Nothing Then
                        If c.Row > NoLigne Then
                            DerLig = c.Row
                            c.EntireRow.Delete
                        End If
                    End If
                    Set c = Nothing
                End With
            Loop While DerLig > NoLigne
        End If
        NoLigne = NoLigne + 1
    Loop While NoLigne < FL1.Range("B65536").End(xlUp).Row
 
End Sub

Encore merci pour ceux qui m'ont aidés.

Nini moins à poil