Est-ce possible d'améliorer et accélérer cette macro?
2 réponses
G. L
Bonsoir à tous,
Partant d'un numéro en colonne "A" qui est souvent répété sur plusieurs
lignes, je supprime les données des cellules D à I et K à L, pour cela j'ai
utilisé deux méthodes, qui suppriment cellule par cellule, je pense qu'en
supprimant l'ensemble des cellules contigues j'obtiendrai un gain de temps,
mais je m'embrouille avec la syntaxe.
Merci d'avance pour votre aide
Gérard
1er méthode :
Sheets("Familles").Select
ActiveWorkbook.Names.Add Name:="Num", RefersToR1C1:= _
"=Familles!R30C1:R20000C1"
Set r = Range("Num")
ligne = Range("A65536").End(xlUp).Row
Range("A30").Select
For n = 1 To ligne
If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 3) = ""
If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 4) = ""
If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 5) = ""
If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 6) = ""
If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 7) = ""
If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 8) = ""
If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 10) = ""
If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 11) = ""
Next n
End Sub
2eme méthode :
Sheets("Familles").Select
For Each Cll In Range("A30:" & Range("A15000").End(xlUp).Address)
If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 3) = ""
If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 4) = ""
If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 5) = ""
If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 6) = ""
If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 7) = ""
If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 8) = ""
If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 10) = ""
If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 11) = ""
Next
End Sub
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Elliac
Bonjour,
Si les libellés en A ne sont pas susceptibles de se retrouver à plusieurs endroits :
Sub Toto() Range("a50000").End(xlUp).Select While ActiveCell.Row <> 2 a = ActiveCell n = Application.CountIf(Columns(1), a) If n > 1 Then Range(ActiveCell, ActiveCell.Offset(-n + 2)).EntireRow.Delete ActiveCell.Offset(-n).Select Else ActiveCell.Offset(-1).Select End If Wend End Sub
Camille
"G. " wrote:
Bonsoir à tous,
Partant d'un numéro en colonne "A" qui est souvent répété sur plusieurs lignes, je supprime les données des cellules D à I et K à L, pour cela j'ai utilisé deux méthodes, qui suppriment cellule par cellule, je pense qu'en supprimant l'ensemble des cellules contigues j'obtiendrai un gain de temps, mais je m'embrouille avec la syntaxe. Merci d'avance pour votre aide Gérard
1er méthode : Sheets("Familles").Select ActiveWorkbook.Names.Add Name:="Num", RefersToR1C1:= _ "úmilles!R30C1:R20000C1" Set r = Range("Num") ligne = Range("A65536").End(xlUp).Row Range("A30").Select For n = 1 To ligne If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 3) = "" If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 4) = "" If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 5) = "" If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 6) = "" If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 7) = "" If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 8) = ""
If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 10) = "" If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 11) = "" Next n End Sub
2eme méthode : Sheets("Familles").Select For Each Cll In Range("A30:" & Range("A15000").End(xlUp).Address) If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 3) = "" If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 4) = "" If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 5) = "" If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 6) = "" If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 7) = "" If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 8) = ""
If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 10) = "" If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 11) = "" Next End Sub
Bonjour,
Si les libellés en A ne sont pas susceptibles de se retrouver à plusieurs
endroits :
Sub Toto()
Range("a50000").End(xlUp).Select
While ActiveCell.Row <> 2
a = ActiveCell
n = Application.CountIf(Columns(1), a)
If n > 1 Then
Range(ActiveCell, ActiveCell.Offset(-n + 2)).EntireRow.Delete
ActiveCell.Offset(-n).Select
Else
ActiveCell.Offset(-1).Select
End If
Wend
End Sub
Camille
"G. L@rumeur" wrote:
Bonsoir à tous,
Partant d'un numéro en colonne "A" qui est souvent répété sur plusieurs
lignes, je supprime les données des cellules D à I et K à L, pour cela j'ai
utilisé deux méthodes, qui suppriment cellule par cellule, je pense qu'en
supprimant l'ensemble des cellules contigues j'obtiendrai un gain de temps,
mais je m'embrouille avec la syntaxe.
Merci d'avance pour votre aide
Gérard
1er méthode :
Sheets("Familles").Select
ActiveWorkbook.Names.Add Name:="Num", RefersToR1C1:= _
"úmilles!R30C1:R20000C1"
Set r = Range("Num")
ligne = Range("A65536").End(xlUp).Row
Range("A30").Select
For n = 1 To ligne
If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 3) = ""
If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 4) = ""
If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 5) = ""
If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 6) = ""
If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 7) = ""
If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 8) = ""
If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 10) = ""
If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 11) = ""
Next n
End Sub
2eme méthode :
Sheets("Familles").Select
For Each Cll In Range("A30:" & Range("A15000").End(xlUp).Address)
If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 3) = ""
If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 4) = ""
If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 5) = ""
If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 6) = ""
If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 7) = ""
If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 8) = ""
If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 10) = ""
If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 11) = ""
Next
End Sub
Si les libellés en A ne sont pas susceptibles de se retrouver à plusieurs endroits :
Sub Toto() Range("a50000").End(xlUp).Select While ActiveCell.Row <> 2 a = ActiveCell n = Application.CountIf(Columns(1), a) If n > 1 Then Range(ActiveCell, ActiveCell.Offset(-n + 2)).EntireRow.Delete ActiveCell.Offset(-n).Select Else ActiveCell.Offset(-1).Select End If Wend End Sub
Camille
"G. " wrote:
Bonsoir à tous,
Partant d'un numéro en colonne "A" qui est souvent répété sur plusieurs lignes, je supprime les données des cellules D à I et K à L, pour cela j'ai utilisé deux méthodes, qui suppriment cellule par cellule, je pense qu'en supprimant l'ensemble des cellules contigues j'obtiendrai un gain de temps, mais je m'embrouille avec la syntaxe. Merci d'avance pour votre aide Gérard
1er méthode : Sheets("Familles").Select ActiveWorkbook.Names.Add Name:="Num", RefersToR1C1:= _ "úmilles!R30C1:R20000C1" Set r = Range("Num") ligne = Range("A65536").End(xlUp).Row Range("A30").Select For n = 1 To ligne If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 3) = "" If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 4) = "" If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 5) = "" If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 6) = "" If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 7) = "" If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 8) = ""
If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 10) = "" If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 11) = "" Next n End Sub
2eme méthode : Sheets("Familles").Select For Each Cll In Range("A30:" & Range("A15000").End(xlUp).Address) If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 3) = "" If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 4) = "" If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 5) = "" If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 6) = "" If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 7) = "" If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 8) = ""
If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 10) = "" If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 11) = "" Next End Sub
G. L
Bonsoir Camille, M%erci de te pencher sur mon problème. Je teste et reviens vers toi si nécessaire Cordialement Gérard
"Elliac" a écrit dans le message de news:
Bonjour,
Si les libellés en A ne sont pas susceptibles de se retrouver à plusieurs endroits :
Sub Toto() Range("a50000").End(xlUp).Select While ActiveCell.Row <> 2 a = ActiveCell n = Application.CountIf(Columns(1), a) If n > 1 Then Range(ActiveCell, ActiveCell.Offset(-n + 2)).EntireRow.Delete ActiveCell.Offset(-n).Select Else ActiveCell.Offset(-1).Select End If Wend End Sub
Camille
"G. " wrote:
Bonsoir à tous,
Partant d'un numéro en colonne "A" qui est souvent répété sur plusieurs lignes, je supprime les données des cellules D à I et K à L, pour cela j'ai
utilisé deux méthodes, qui suppriment cellule par cellule, je pense qu'en
supprimant l'ensemble des cellules contigues j'obtiendrai un gain de temps,
mais je m'embrouille avec la syntaxe. Merci d'avance pour votre aide Gérard
1er méthode : Sheets("Familles").Select ActiveWorkbook.Names.Add Name:="Num", RefersToR1C1:= _ "úmilles!R30C1:R20000C1" Set r = Range("Num") ligne = Range("A65536").End(xlUp).Row Range("A30").Select For n = 1 To ligne If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 3) = "" If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 4) = "" If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 5) = "" If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 6) = "" If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 7) = "" If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 8) = ""
If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 10) = "" If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 11) = "" Next n End Sub
2eme méthode : Sheets("Familles").Select For Each Cll In Range("A30:" & Range("A15000").End(xlUp).Address) If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 3) = "" If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 4) = "" If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 5) = "" If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 6) = "" If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 7) = "" If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 8) = ""
If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 10) = "" If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 11) = "" Next End Sub
Bonsoir Camille,
M%erci de te pencher sur mon problème.
Je teste et reviens vers toi si nécessaire
Cordialement
Gérard
"Elliac" <Elliac@discussions.microsoft.com> a écrit dans le message de
news:555BDF15-6816-418F-AF9B-B0ADDED54462@microsoft.com...
Bonjour,
Si les libellés en A ne sont pas susceptibles de se retrouver à plusieurs
endroits :
Sub Toto()
Range("a50000").End(xlUp).Select
While ActiveCell.Row <> 2
a = ActiveCell
n = Application.CountIf(Columns(1), a)
If n > 1 Then
Range(ActiveCell, ActiveCell.Offset(-n + 2)).EntireRow.Delete
ActiveCell.Offset(-n).Select
Else
ActiveCell.Offset(-1).Select
End If
Wend
End Sub
Camille
"G. L@rumeur" wrote:
Bonsoir à tous,
Partant d'un numéro en colonne "A" qui est souvent répété sur plusieurs
lignes, je supprime les données des cellules D à I et K à L, pour cela
j'ai
utilisé deux méthodes, qui suppriment cellule par cellule, je pense
qu'en
supprimant l'ensemble des cellules contigues j'obtiendrai un gain de
temps,
mais je m'embrouille avec la syntaxe.
Merci d'avance pour votre aide
Gérard
1er méthode :
Sheets("Familles").Select
ActiveWorkbook.Names.Add Name:="Num", RefersToR1C1:= _
"úmilles!R30C1:R20000C1"
Set r = Range("Num")
ligne = Range("A65536").End(xlUp).Row
Range("A30").Select
For n = 1 To ligne
If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 3) = ""
If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 4) = ""
If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 5) = ""
If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 6) = ""
If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 7) = ""
If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 8) = ""
If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 10) = ""
If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 11) = ""
Next n
End Sub
2eme méthode :
Sheets("Familles").Select
For Each Cll In Range("A30:" & Range("A15000").End(xlUp).Address)
If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 3) = ""
If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 4) = ""
If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 5) = ""
If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 6) = ""
If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 7) = ""
If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 8) = ""
If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 10) = ""
If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 11) = ""
Next
End Sub
Bonsoir Camille, M%erci de te pencher sur mon problème. Je teste et reviens vers toi si nécessaire Cordialement Gérard
"Elliac" a écrit dans le message de news:
Bonjour,
Si les libellés en A ne sont pas susceptibles de se retrouver à plusieurs endroits :
Sub Toto() Range("a50000").End(xlUp).Select While ActiveCell.Row <> 2 a = ActiveCell n = Application.CountIf(Columns(1), a) If n > 1 Then Range(ActiveCell, ActiveCell.Offset(-n + 2)).EntireRow.Delete ActiveCell.Offset(-n).Select Else ActiveCell.Offset(-1).Select End If Wend End Sub
Camille
"G. " wrote:
Bonsoir à tous,
Partant d'un numéro en colonne "A" qui est souvent répété sur plusieurs lignes, je supprime les données des cellules D à I et K à L, pour cela j'ai
utilisé deux méthodes, qui suppriment cellule par cellule, je pense qu'en
supprimant l'ensemble des cellules contigues j'obtiendrai un gain de temps,
mais je m'embrouille avec la syntaxe. Merci d'avance pour votre aide Gérard
1er méthode : Sheets("Familles").Select ActiveWorkbook.Names.Add Name:="Num", RefersToR1C1:= _ "úmilles!R30C1:R20000C1" Set r = Range("Num") ligne = Range("A65536").End(xlUp).Row Range("A30").Select For n = 1 To ligne If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 3) = "" If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 4) = "" If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 5) = "" If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 6) = "" If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 7) = "" If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 8) = ""
If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 10) = "" If r.Cells(n, 1) = r.Cells(n + 1, 1) Then r.Cells(n + 1, 11) = "" Next n End Sub
2eme méthode : Sheets("Familles").Select For Each Cll In Range("A30:" & Range("A15000").End(xlUp).Address) If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 3) = "" If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 4) = "" If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 5) = "" If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 6) = "" If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 7) = "" If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 8) = ""
If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 10) = "" If Cll.Offset(1, 0) = Cll Then Cll.Offset(1, 11) = "" Next End Sub
