VBA Optimisation de Script

Version imprimable

Bonjour,

Pouvez-vous me aidé ?

J'aurais aimé optimisé mon scripte:
Code:

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

Bonjour sawsliders,

Peut-être

Code:

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

Salut

Il faudra sans doute adapter un peu

Code:

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

15/07/2015, 13h34
sawsliders
Citation:
Envoyé par tototiti2008

Bonjour sawsliders,

Peut-être

Code:

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

Citation:
Envoyé par Qwazerty
Salut

Il faudra sans doute adapter un peu
Code:

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.

15/07/2015, 13h48
tototiti2008
Bonjour sawsliders, Bonjour Qwazerty,

Citation:

Envoyé par sawsliders

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:

1 2 ActiveSheet.ListObjects.Add(xlSrcRange, Range("$B$4:$AG$100"), , xlYes).Name = _ "Tableau1"
Et ça ne réponds qu'à l'étape 1
15/07/2015, 18h53
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

Bonjour,

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

Code:

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

Salut

... je suis confus, en relisant ton 1er message je m’aperçois que j'ai fourni une réponse... comment dire ... bref ("Il faudra sans doute adapter un peu"... pour le moins mais j'avais prévenu hein )

Ça devrait être mieux...

Code:

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
Option Explicit
 
 
Sub heuuDesole()
    Dim NewTab As ListObject
    Dim NewCol As ListColumn
    Dim iCell As Long
 
    'Il serait mieux de nommer correctement la feuille sur laquelle tu travailles
    With ActiveSheet
        'On transforme une partie du contenu de la feuille en tableau
        Set NewTab = .ListObjects.Add(xlSrcRange, .Range("B4").CurrentRegion, , xlYes)
    End With
    With NewTab
        'On renome ce tableau
        .Name = "Tableau1" 'Si tu ne t'en resserres pas, tu peux laisser la valeur par défaut, ça évite les ennui de conflit avec un Tableau1 qui existerait déjà...
        'On ajoute une colonne
        Set NewCol = .ListColumns.Add(1)
        NewCol.Name = "N°"
        'On boucle sur les cellules de la colonne 3
        For iCell = .ListRows.Count To 1 Step -1
            'Si le contenu est "Terminé" on supprime la ligne du tableau
            If .DataBodyRange.Cells(iCell, 3).Value = "Terminé" Then
                NewTab.ListRows(iCell).Delete
            End If
        Next
    End With
End Sub

PS: Pratique le CurrentRegion tototiti2008, je ne l'utilisais jamais, je vais essayer de m'en souvenir!
++
Qwaz