Code tres lent

[Ilino]

Bonjour FOrum
ci dessous le code de retour chariot elaboré par JOB en 19/05/2013 a 11h02( je tien a le remerci) et adapter par ILINIO;

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim t As Range
Set t = Intersect(Target, [A4:AG4])
If Not t Is Nothing Then Ajustement t, [A:AG], [A:AG], xlCenter
Set t = Intersect(Target, [B21:AG30])
If Not t Is Nothing Then Ajustement t, [B:AG], [B:AG], xlGeneral
End Sub

Sub Ajustement(t As Range, plage1 As Range, plage2 As Range, align)
Dim r1 As Range, r2 As Range, h As Double
Application.ScreenUpdating = False
For Each t In t ' si plusieurs cellules sont modifiées
  Set r1 = Intersect(t.EntireRow, plage1)
  Set r2 = Intersect(t.EntireRow, plage2)
  Union(r1, r2).UnMerge 'défusionne
  r1.HorizontalAlignment = xlCenterAcrossSelection
  r2.HorizontalAlignment = xlCenterAcrossSelection
  r1.WrapText = True: r2.WrapText = True 'renvoi à la ligne
  r1.Rows.AutoFit 'ajustement automatiquement
  h = r1.Rows.Height 'mémorise la hauteur
  r1.Merge: r2.Merge 'refusionne
  Union(r1, r2).HorizontalAlignment = align
  If h < 409 Then r1.RowHeight = h 'hauteur de ligne
Next
End Sub

Mon souci est : pourquoi il est tres lent quand j'efface les données des cellule fusionnées ( rouge)😕

grazie

 

[Ilino]

Re : Code tres lent

Re,

peux-être tous simplement je dois ajouter cette instruction e début de Procédure.
Application.ScreenUpdating = False

et celle-ci en fin de procédures
Application.ScreenUpdating = True

Pour l'obtimisation du temps de traitement ?????
A+

 

[job75]

Re : Code tres lent

Bonsoir Ilino,

Pourquoi ne pas rester sur le fil d'origine pour qu'on puisse comprendre ?

De toute façon la durée d'exécution me paraît normale.

A+

 

[Ilino]

Re : Code tres lent

Re
oky maitre
a+

 

[job75]

Re : Code tres lent

Re,

Bien entendu il est inutile d'indiquer 2 plages de colonnes puisqu'il n'y en a qu'une :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim t As Range
Set t = Intersect(Target, [A4:AG4])
If Not t Is Nothing Then Ajustement t, [A:AG], xlCenter
Set t = Intersect(Target, [B21:AG30])
If Not t Is Nothing Then Ajustement t, [B:AG], xlGeneral
End Sub

Sub Ajustement(t As Range, plage1 As Range, align)
Dim r1 As Range, h As Double
Application.ScreenUpdating = False
For Each t In t ' si plusieurs cellules sont modifiées
  Set r1 = Intersect(t.EntireRow, plage1)
  r1.UnMerge 'défusionne
  r1.HorizontalAlignment = xlCenterAcrossSelection
  r1.WrapText = True 'renvoi à la ligne
  r1.Rows.AutoFit 'ajustement automatiquement
  h = r1.Rows.Height 'mémorise la hauteur
  r1.Merge 'refusionne
  r1.HorizontalAlignment = align
  If h < 409 Then r1.RowHeight = h 'hauteur de ligne
Next
End Sub

Cela ne change pas grand-chose pour la durée d'exécution.

A+

 

[Ilino]

Re : Code tres lent

Re,

Bien entendu il est inutile d'indiquer 2 plages de colonnes puisqu'il n'y en a qu'une :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim t As Range
Set t = Intersect(Target, [A4:AG4])
If Not t Is Nothing Then Ajustement t, [A:AG], xlCenter
Set t = Intersect(Target, [B21:AG30])
If Not t Is Nothing Then Ajustement t, [B:AG], xlGeneral
End Sub

Sub Ajustement(t As Range, plage1 As Range, align)
Dim r1 As Range, h As Double
Application.ScreenUpdating = False
For Each t In t ' si plusieurs cellules sont modifiées
  Set r1 = Intersect(t.EntireRow, plage1)
  r1.UnMerge 'défusionne
  r1.HorizontalAlignment = xlCenterAcrossSelection
  r1.WrapText = True 'renvoi à la ligne
  r1.Rows.AutoFit 'ajustement automatiquement
  h = r1.Rows.Height 'mémorise la hauteur
  r1.Merge 'refusionne
  r1.HorizontalAlignment = align
  If h < 409 Then r1.RowHeight = h 'hauteur de ligne
Next
End Sub

Cela ne change pas grand-chose pour la durée d'exécution.

A+

Re
Sorry JOB
AVEC ce code j'ai une erreur de compilation :imcompatibilité de type
sur la ligne
xlCenter
?
A+

 

[job75]

Re : Code tres lent

Re,

Pas chez moi.

A+

 

[Ilino]

Re : Code tres lent

Re,
oky maitre
grazie