Discussion :

[sawsliders]

Bonjour,

Pouvez-vous me aidé ?

J'aurais aimé optimisé mon scripte:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
 
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$B$4:$AG$100"), , xlYes).Name = _
        "Tableau1"
    Range("B4").Select
    Selection.ListObject.ListColumns.Add Position:=1
    ActiveCell.FormulaR1C1 = "N°"
    Range("B5").Select
    ActiveSheet.ListObjects("Tableau1").Range.AutoFilter Field:=3, Criteria1:= _
        "Terminé"
    Range("B5:AH100").Select
    Selection.EntireRow.Delete
    ActiveSheet.ListObjects("Tableau1").Range.AutoFilter Field:=3

Voila se qu'il fait pour moi :


Étape 1 : Il crée un tableau qui a partir des cellule B4 jusqu’à AG100

J'aurais aimé :

Qu'il trouve la deniers ligne écrite et qu'il crée une valeur dynamique à la place de 100

Exemple :

$B$4:$AG$XX

Étape 2 : Il supprime les lignes avec une valeur "terminé" dans la colonne C (ou colonne 2 du tableau)

Mon script fonctionne que pour 100 lignes alors que demain je peux avoir un fichier avec 1000 ligne donc pour être sur qu'il le prenne en charge toute les lignes.

Je sais pas si j'ai été claire mais je l’espéré :s

[tototiti2008]

Bonjour sawsliders,

Peut-être

Code :

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

1
2
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$B$4").currentregion, , xlYes).Name = _
"Tableau1"

[Qwazerty]

Salut

Il faudra sans doute adapter un peu

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
Option Explicit
 
Sub teste()
Dim TheCell As Range
 
    'J'utilise activeSheet faute d'information mais il serait préférable de nommer sur quelle feuille tu travailles
    With ActiveSheet
        'On pointes les cellule de la colonne B l'une après l'autre
        For Each TheCell In .Range("D4", .Cells(.Rows.Count, "D").End(xlUp))
            'Si la cellule contient le mot clé, on supprime la ligne complète
            If TheCell.Value = "Terminé" Then TheCell.EntireRow.Delete
        Next
    End With
 
End Sub

++
Qwaz

[sawsliders]

Salut

Il faudra sans doute adapter un peu

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
Option Explicit
 
Sub teste()
Dim TheCell As Range
 
    'J'utilise activeSheet faute d'information mais il serait préférable de nommer sur quelle feuille tu travailles
    With ActiveSheet
        'On pointes les cellule de la colonne B l'une après l'autre
        For Each TheCell In .Range("D4", .Cells(.Rows.Count, "D").End(xlUp))
            'Si la cellule contient le mot clé, on supprime la ligne complète
            If TheCell.Value = "Terminé" Then TheCell.EntireRow.Delete
        Next
    End With
 
End Sub

++
Qwaz

Bonjour,

Excuse moi de mon retard sur mon post.

Je t'avoue que cette solution m'aurais intéressé en amont mais j'ai étudié mon excel sous forme de tableau (permet une intégration de formules sur toute une colonne entre deux lignes).

si je suis ta formules cela me crée une vague d'erreur derriere sur mes autre lignes de codes.

[sawsliders]

Bonjour sawsliders,

Peut-être

Code :

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

1
2
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$B$4").currentregion, , xlYes).Name = _
"Tableau1"

Bonjour,

Tout d'abord merci de ton écoute sur mon message précédent et désolé du retard sur mon retour.

je dois le mettre a quel niveaux de mon script ?(remplace un bout à moi ?)

Merci de ton retour

[tototiti2008]

Bonjour sawsliders, Bonjour Qwazerty,

Bonjour,

Tout d'abord merci de ton écoute sur mon message précédent et désolé du retard sur mon retour.

je dois le mettre a quel niveaux de mon script ?(remplace un bout à moi ?)

Merci de ton retour

Oui, ça remplace ta ligne

Code :

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

1
2
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$B$4:$AG$100"), , xlYes).Name = _
"Tableau1"

Et ça ne réponds qu'à l'étape 1

[Qwazerty]

Salut

Désolé je ne comprends pas ton problème, j'imagine que le fait de supprimer une ligne complète efface des données situées en marge de ton tableau?

Pour l'utilisation d'un tableau je ne savais pas [Edit]...oui c'est présent dans ton code je ne sais pas pourquoi je suis pas parti la dessus...[/Edit], c'est encore mieux, il suffit de donner à la boucle le nom de la colonne qu'elle doit contrôler, puis de supprimer non plus la ligne complète de la feuille mais uniquement la ligne du tableau.

Avant de te proposer un code, j'aimerais être sur que cela colle à ton besoin.

++
Qwaz

[joe.levrai]

Bonjour,

une proposition qui semble répondre à tes deux demandes ... optimisable pour les plus tâtillons
adapter la feuille (ligne 9)

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
Sub ioi()
Dim Tabl As ListObject
Dim CellRech As Range
Dim Repere As String
Dim Continuer As Boolean
 
Application.ScreenUpdating = False
 
With Feuil1
    ' création du ListObject
    Set Tabl = .ListObjects.Add(xlSrcRange, .Cells(1, 2).CurrentRegion, , xlYes)
 
    ' on cherche la première occurence "terminé"
    Set CellRech = Tabl.Range.Columns(2).Find("terminé", .Cells(1, 3), xlValues, xlWhole)
 
    ' s'il y en a une
    If Not CellRech Is Nothing Then
 
        ' on stock l'adresse du résultat
        Repere = CellRech.Address
 
        ' on supprime la ligne
        CellRech.EntireRow.Delete
 
        ' on met un drapeau pour faire une boucle de recherche
        Continuer = True
        While Continuer = True
 
            ' recherche des occurences suivantes
            Set CellRech = Tabl.Range.Columns(2).Find("terminé", .Range(Repere).Offset(-1, 0), xlValues, xlWhole)
            If Not CellRech Is Nothing Then
               Repere = CellRech.Address
                CellRech.EntireRow.Delete
            Else
                ' permet de s'arrêter quand il n'y a plus de résultat
                Continuer = False
            End If
        Wend
    End If
End With
 
Application.ScreenUpdating = True
End Sub