sélection de plages multiples

[stevenfodder]

Bonjour à tous,

Je visite beaucoup les forum mais je n'arrive pas à résoudre mon problème :

Je dois faire la sélection d'un ensemble de plages (plus de 20) de cellules sur une colonne (variable) puis effacer ces cellules.
Ce que j'ai commencé "fonctionne" mais en vue de l'application de cette macro, il me semble que cela se passe dans la douleurs et la vitesse est lente.
Si quelqu'un peut me donner un coup de main, je suis preneur pour les bonnes idées.
Voici la macro en question:


Sub Effacer_un_resultat()
'
' Effacer_un_resultat Macro
' Macro enregistrée le 08/04/2008 par sf
'

ligD = 1
colD = 27
valnbD = 7

'Vérification si la zone de collage est dispo, si non, décalage:
Do While Cells(ligD, colD).Value = ""
colD = colD - 1
valnbD = valnbD - 1
Loop

'Selection des zones à effacer et effacement:

Cells(ligD, colD).Select
Selection.ClearContents

[A1].Offset(ligD + 13, colD - 1).Resize(4, 1).Select
Selection.ClearContents
[A1].Offset(ligD + 19, colD - 1).Resize(3, 1).Select
Selection.ClearContents


'Enlever le calcul automatique des cellules:
With Application
.Calculation = xlAutomatic
.MaxChange = 0.001
End With
ActiveWorkbook.PrecisionAsDisplayed = False

Range("A8").Select
Range("T8").Select
ActiveSheet.Protect



End Sub


[/COLOR]

 

[skoobi]

Re : sélection de plages multiples

Bonjour,

en bleu ce que j'ai modifié:

Sub Effacer_un_resultat()
'
' Effacer_un_resultat Macro
' Macro enregistrée le 08/04/2008 par sf
'

ligD = 1
colD = 27
valnbD = 7

'Recherche la première cellule non vide en partant de la droite vers la gauche depuis la colonne 27
[COLOR=Blue][B]colD = Cells(1, 27).End(xlToLeft).Column[/B][/COLOR]
'Selection des zones à effacer et effacement:

[B][COLOR=Blue]Cells(ligD, colD).ClearContents[/COLOR][/B]

[COLOR=Blue][B][A1].Offset(ligD + 13, colD - 1).Resize(4, 1).ClearContents
[A1].Offset(ligD + 19, colD - 1).Resize(3, 1).ClearContents[/B][/COLOR]

'Enlever le calcul automatique des cellules:
With Application
.Calculation = xlAutomatic
.MaxChange = 0.001
End With
ActiveWorkbook.PrecisionAsDisplayed = False


ActiveSheet.Protect

End Sub

Tu auras remarqué que j'ai supprimé les lignes avec .Select.
Ceci est inutile dans un code et le ralenti... (le défaut de l'enregistreur de macro)