Supprimer lignes entieres selon critère dans une colonne

**Freudsw** · 28/09/2015, 10h05

Bonjour à tous,

j'ai commencé à créer une macro qui me permet de copier les données se trouvant dans un autre classeur et au même temps de traiter les données.
Ma macro me permet d'ouvrir toujours le même fichier or que le fichier en question change chaque mois, y a t-il un moyen de configurer la macro de telle sorte qu'il me copie toujours le fichier dont j'ai besoin?

Une fois les données copiées, j'aimerais faire plusieurs traitements; le premier consisite à supprimer chaque ligne si la valeur de la coolonne 8 est comprise en -0.01 et 0.01

Par la suite, j'aimerais classer ces lignes selon les valeurs de la colonne 8 de la plus grande à la plus petite et copier les trois premieres lignes sur une autre feuille qui s'appele (CPN1).

Enfin, j'aimerais selectionner 6 lignes aléatoirement parmi les lignes restantes et les copier toujours dans la feuille (CPN1).

je vous mets ci-dessus le code que j'ai commencé à faire.

merci pour votre aide.

Cordialement,
Freudsw

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
Sub extraction()
Dim source As Workbook
Dim oRng As Range
Dim i As Integer
Application.ScreenUpdating = False
 
Set source = Workbooks.Open("\\08-2015\Xtract D1 Août 15.xlsx")
With source
    .Worksheets("Sheet1").UsedRange.Copy ThisWorkbook.Worksheets("Échantillon").Range("A1")
    .Close False
End With
 
 
With ThisWorkbook.Worksheets("Échantillon")
Set oRng = .Range("H1")
For i = .Cells(Rows.Count, 8).End(xlUp).Row To 2 Step -1
  If oRng.Offset(i, 0) < 0.01 And oRng.Offset(i, 0) > -0.01 Then
                'On supprime la ligne
    oRng.Offset(i, 0).EntireRow.Delete
  End If
Next i
End With
Application.ScreenUpdating = True
End Sub

**Daniel.C** · 28/09/2015, 10h06

Bonjour,

Ma macro me permet d'ouvrir toujours le même fichier or que le fichier en question change chaque mois, y a t-il un moyen de configurer la macro de telle sorte qu'il me copie toujours le fichier dont j'ai besoin?

Est-ce qu'il y a un moyen de reconnaître quel est le classeur à utiliser ? Sinon, utilise la méthode GetOpenFilename pour choisir le fichier.

Une fois les données copiées, j'aimerais faire plusieurs traitements; le premier consisite à supprimer chaque ligne si la valeur de la coolonne 8 est comprise en -0.01 et 0.01

Filtre tes données et supprime les lignes filtrées.

Par la suite, j'aimerais classer ces lignes selon les valeurs de la colonne 8 de la plus grande à la plus petite et copier les trois premieres lignes sur une autre feuille qui s'appele (CPN1).

Utilise le filtre pour trier tes données, sélectionne les 3 premières lignes et copie-les.

Enfin, j'aimerais selectionner 6 lignes aléatoirement parmi les lignes restantes et les copier toujours dans la feuille (CPN1).

Ajoute une colonne à tes données, mets dans chaque cellules de la colonne la fonction ALEA, trie sur cette colonne et fais la copie. Si tu bloques dans le VBA, dis-le.

**Freudsw** · 28/09/2015, 10h24

Bonjour Daniel,

S'agissant de reconnaitre le fichier, oui on peut le reconnaitre vu qu'il se trouve toujours dans un dossier correspondant au derniers mois, par exemple dans le code j'ai mis (08-2015) et le fichier s'appelle "Xtract D1 Août 15.xlsx". Donc pour le mois prochain, le fichier se trouvera dans le dossier (09-2015) et le fichier s'appelera "Xtract D1 Septembre 15.xlsx"

Comme je suis novice en VBA, je ne sais pas comment utiliser ta commande (GetOpenFilename).

Pour les selections et copie, j'ai pensé à faire le filtre mais je sais pas comment m'y prendre.

Merci encore.

Cordialement,
Freudsw

**Daniel.C** · 28/09/2015, 12h27

Pour le fichier, tu peux mettre :

Code :

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

Set source = Workbooks.Open("\\08-2015\Xtract D1 " & Format(DateSerial(Year(datee), Month(Date) - 1, Day(Date)), "mmmm") & "15.xlsx")

Pour le reste, mets ton classeur en pièce jointe sans données confidentielles.

**Freudsw** · 28/09/2015, 15h25

Re-Bonjour,

Pour la source, je n'ai pas donné le chemin complet, sachant que la source se trouve dans un sous dossier quis'appelle"Arrêtes 2015" et que dans ce dossier il y a plusieurs sous dossiers coorespondant à chaque mois (08-2015) , (09-2015)....etc
donc mon ficher se trouve a chaque fois dans l'un des dossiers, comment peut-on adapter le chemin ?

Code :

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

Set source = Workbooks.Open("\\08-2015\Xtract D1 " & Format(DateSerial(Year(datee), Month(Date) - 1, Day(Date)), "mmmm") & "15.xlsx")

j'ai essayé de faire tous les traitements tout seul et j'ai le code suivant:

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
Sub extraction()
Dim source As Workbook
Dim oRng As Range
Dim i As Integer
Dim ListeLig As String
Application.ScreenUpdating = False
Set source = Workbooks.Open("\\10-Arrêtes 2015\08-2015\Xtract D1 Août 15.xlsx")
With source
    .Worksheets("Sheet1").UsedRange.Copy ThisWorkbook.Worksheets("Échantillon").Range("A1")
    .Close False
End With
 
 
With ThisWorkbook.Worksheets("Échantillon")
Set oRng = .Range("H1")
For i = .Cells(Rows.Count, 8).End(xlUp).Row To 2 Step -1
  If oRng.Offset(i, 0) < 0.01 And oRng.Offset(i, 0) > -0.01 Then
                'On supprime la ligne
     oRng.Offset(i, 0).EntireRow.Delete
  End If
Next i
If .FilterMode = True Then .ShowAllData
End With
 
 
'j'ai fait cette partie avec l'enregistreur de macro mais ça bloque au niveau de (ActiveWorkbook.Worksheets("Échantillon").AutoFilter.Sort.SortFields.Clear)
 
 
 
Sheets("Échantillon").Select
    Cells.Select
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("Échantillon").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Échantillon").AutoFilter.Sort.SortFields.Add Key:= _
        Range("H1:H235"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    With ActiveWorkbook.Worksheets("Échantillon").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Rows("2:4").Select
    Selection.Copy
    Sheets("CPN1").Select
    Range("A2").Select
    ActiveSheet.Paste
 
 
 
 
 
 
With ThisWorkbook.Worksheets("Échantillon")
 
ListeLig = ""  ' initialisation de la liste des lignes choisies pour cette feuille
For i = 1 To 6  ' on va piocher trois lignes
 
            ' définition de la ligne piochées
LigChoisie = Int((.Cells(.Rows.Count, 1).End(xlUp).Row - 5) * Rnd + 5)
 
            ' tant que la ligne piochée a déjà été utilisée
While ListeLig Like "*$" & LigChoisie & "$*"
                ' on en pioche une autre
      LigChoisie = Int((.Cells(.Rows.Count, 1).End(xlUp).Row - 5) * Rnd + 5)
Wend
 
            ' on ajoute la ligne piochée à la liste des lignes utilisées
ListeLig = ListeLig & "$" & LigChoisie & "$"
            ' on écrit la ligne
.Cells(LigChoisie, 1).Resize(1, .UsedRange.Columns.Count).Copy ThisWorkbook.Worksheets("CPN1").Cells(5, 1).Offset(t, 0)
            t = t + 1
Next i
End With
 
Application.ScreenUpdating = True
End Sub

Il marche trés bien, mis à part cette partie qui bloque des fois car je l'ai faite avec l'enregistreur de macro:
elle bloque au niveau de ActiveWorkbook.Worksheets("Échantillon").AutoFilter.Sort.SortFields.Clear

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
Sheets("Échantillon").Select
    Cells.Select
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("Échantillon").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Échantillon").AutoFilter.Sort.SortFields.Add Key:= _
        Range("H1:H235"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    With ActiveWorkbook.Worksheets("Échantillon").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Rows("2:4").Select
    Selection.Copy
    Sheets("CPN1").Select
    Range("A2").Select
    ActiveSheet.Paste

Comment on peut l'ameliorer ?

je vous remercie par avance.

Cordialement,
Freudsw

**Daniel.C** · 28/09/2015, 16h04

Pour la date, utilise :

Code :

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

1
2
3
4
5
6
Dim Fichier As String
Dim Dat As Date
Application.ScreenUpdating = False
Dat = DateSerial(Year(Date), Month(Date) - 1, Day(Date))
Fichier = "\\10-Arrêtes " & Year(Dat) & "\" & Format(Dat, "mm-yyyy") & "\Xtract D1 " & Format(Dat, "mmmm yy") & ".xlsx"
Set source = Workbooks.Open(Fichier)

Pour le reste, sans voir ton classeur, c'est difficile, mais généralement, on ne filltre pas toutes les cellules de la feuille.

**Freudsw** · 28/09/2015, 16h41

Pour la source, le code fonctionne parfaitement, Merci beaucoups.

Concernant, le filtrage des données et le copiage des trois premieres lignes dans la feuille (CPN1), le code fonctionne quand on le lance la premiere fois mais par la suite il le met debogage.

Je te joins ici le fichier, tu pourras le voir et me dire ce qui ne fonctionne pas.
j'ai ajouté une feuille (extraction brute) pourt que tu vois d'ou vienne les données, j'ai juste fais copié collé dans la feuille échantillon pour le traitement.

Merci encore.

Cordialement,
Freudsw

**Daniel.C** · 28/09/2015, 17h17

"Autofilter" positionne le filtre s'il n'existe pas ou l'efface dans le cas contraire. Dans le cas où il est effacé, le ligne suivante plante :

Code :

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

ActiveWorkbook.Worksheets("Échantillon").AutoFilter.Sort.SortFields.Clear

puisque l'objet "Autofilter" n'existe pas. J'ai ajouté :

Code :

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

Sheets("Échantillon").AutoFilterMode = False

pour effacer le filtre. Ainsi,

Code :

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

Selection.AutoFilter

le crée.

Code :

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

1
2
3
4
5
Sheets("Échantillon").Select
    Sheets("Échantillon").AutoFilterMode = False
    Range("H1").Select
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("Échantillon").AutoFilter.Sort.SortFields.Clear

**Freudsw** · 28/09/2015, 17h27

parfait, le code fonctionne trés bien.
Je te remerci encore.

Cordialement,
Freudsw

Supprimer lignes entieres selon critère dans une colonne [XL-2010]

Macros et VBA Excel

Discussions similaires

Partager

Partager