Problème hauteur de ligne filtre automatique

[gant1801]

Bonjour,
j'ai mis en place un code permettant d'effectuer rapidement un filtre automatique de mon tableau.
Le code ainsi créé (voir ci-dessous) est parfaitement fonctionnel et permet de mettre en place le filtre.

Sub Tri()

Dim L As Integer
L = Range("B10000").End(xlUp).Row

    ActiveWorkbook.Worksheets("Travail").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Travail").AutoFilter.Sort.SortFields.Add Key:= _
        Range(Cells(2, 4), Cells(L, 4)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Travail").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Seulement le soucis c'est que cela change la hauteur des lignes que j'avais préalablement ajusté. J'ai donc mis en place le code suivant pour remettre la bonne hauteur à chaque ligne.
Mais le problème c'est que ce dernier est très lourd : il reprend la hauteur de chaque ligne une à une, le travail peut être long si le fichier contient de nombreuses lignes.
Auriez-vous des idées pour l'améliorer?
Merci!

Sub Revoir_hauteur_ligne()

Dim J As Integer
Dim K As Integer
J = Range("B65000").End(xlUp).Row + 1
For K = 6 To J
    Rows(K).EntireRow.AutoFit
    Rows(K).RowHeight = WorksheetFunction.Max(28, Rows(K).RowHeight)
Next K

End Sub

 

[Gelinotte]

Re : Problème hauteur de ligne filtre automatique

Bonjour,

Peut-être ceci :

Sub Revoir_hauteur_ligne()

Dim J As Integer
J = Range("B65000").End(xlUp).Row + 1

Rows("6:" & J).EntireRow.AutoFit
Rows("6:" & J).RowHeight = WorksheetFunction.Max(28, Rows("6:" & J).RowHeight)

End Sub

Geli

 

[Paf]

Re : Problème hauteur de ligne filtre automatique

Bonjour

Pas sûr d'avoir compris la ligne WorksheetFunction.Max(28, Rows(K).RowHeight) qui me sort toujours 28 quelque soit la hauteur initiale des lignes.

Si c'est pour avoir des lignes de 28 de haut:

Sub Revoir_hauteur_ligne()
Dim J As Integer

J = Range("B65000").End(xlUp).Row 
Rows("6:" & J).RowHeight = 28
Next K

End Sub

testé sur PC

A+

edit : bonjour Gelinotte

re edit : tiens j'ai oublié d'enlever un Next K inutile et "planteur"

 

[Staple1600]

Re : Problème hauteur de ligne filtre automatique

Bonjour à tous

Comme je disais dans l'autre fil de gant1801
Sub Revoir_hauteur_ligne()
Dim J As Long
J = Range("B65000").End(xlUp).Row
Rows("6:" & J).RowHeight = 28
Next K
End Sub

 

[gant1801]

Re : Problème hauteur de ligne filtre automatique

Bonjour à tous,

Merci de vous plancher sur mon problème.
La solution que propose Gelinotte est intéressante, mais la deuxième ligne ne fonctionne pas. Je m'explique:

Le code suivant marche parfaitement

Sub Revoir_hauteur_ligne()
Dim J As Long
J = Range("B65000").End(xlUp).Row + 1
Rows("6:" & J).EntireRow.AutoFit
End Sub

En revanche, cette partie ne marche pas : Rows("6:" & J).RowHeight = WorksheetFunction.Max(28, Rows("6:" & J).RowHeight)

L'idée est que ma ligne finale fasse 28 de haut au minimum, et que la hauteur soit ajustée si il y a trop de texte (texte fait un retour à la ligne automatique.
Désolé de ne m'être pas exprimé plus clairement dès le début.

Si vous avez des idées, merci de votre aide!!

Gant

 

[Paf]

Re : Problème hauteur de ligne filtre automatique

Re,

pour la dernière ligne, s'il y a déjà eu AutoFit d'effectué avant, rajouter juste l'instruction :

If Rows(J).RowHeight<28 Then Rows(J).RowHeight=28

A+

 

[gant1801]

Re : Problème hauteur de ligne filtre automatique

Merci pour ton aide!

J'ai ajusté pour faire le code suivant qui marche bien. Il est plus rapide que mon premier code mais n'est sans doute pas optimum (encore long à l'exécution), si vous avez des idées pour l'améliorer encore je vous en serais très reconnaissant…

Gant

Sub Revoir_hauteur_ligne()

Dim J As Integer
Dim K As Integer
J = Range("B65000").End(xlUp).Row + 1

Rows("6:" & J).EntireRow.AutoFit

For K = 6 To J
If Rows(K).RowHeight < 28 Then
Rows(K).RowHeight = 28
End If
Next K

End Sub

 

[gant1801]

Re : Problème hauteur de ligne filtre automatique

Pas d'idées?

 

[gant1801]

Re : Problème hauteur de ligne filtre automatique

Y aurait-il un génie qui saurait comment réduire le temps d'exécution de la macro?
En effet, elle est assez lourde quand il y a de nombreuses lignes…
Merci ;-)