Sub filtreComment()
For Each c In Range("b2:B" & [B65000].End(xlUp).Row)
c.EntireRow.Hidden = c.Comment Is Nothing
Next c
End Sub
Sub tout()
Rows.Hidden = False
End Sub
Sub filtreComment()
For Each c In Range("b2:B" & [B65000].End(xlUp).Row)
c.EntireRow.Hidden = EstCommentaire(c)
Next c
End Sub
Sub tout()
Rows.Hidden = False
End Sub
Function EstCommentaire(c)
Application.Volatile
EstCommentaire = [COLOR="Red"]Not[/COLOR] c.Comment Is Nothing
End Function
Sub TrierCommentaire()
'se lance par Ctrl+T
Dim c As Range, sep$, s
Set c = [G15] 'à adapter
sep = vbLf & "- " 'séparateur à adapter
If c.Comment Is Nothing Then Exit Sub
s = Split(c.Comment.Text, sep)
If UBound(s) < 2 Then Exit Sub
Application.ScreenUpdating = False
With Workbooks.Add.Sheets(1).[A1].Resize(UBound(s) + 1) 'classeur auxiliaire
.Value = Application.Transpose(s)
.Sort .Columns(1), xlAscending, Header:=xlYes
c.Comment.Text Join(Application.Transpose(.Value), sep)
.Parent.Parent.Close False 'fermeture du classeur auxiliaire
End With
c.Comment.Shape.TextFrame.Characters(Len(s(0)) + 1).Font.Bold = False 'non gras
End Sub
Sub TrierCommentaires()
'se lance par Ctrl+T
Dim r As Range, sep$, s
Set r = [G:G] 'plage à adapter
sep = vbLf & "- " 'séparateur à adapter
Application.ScreenUpdating = False
On Error Resume Next 'si aucun commentaire
Set r = r.SpecialCells(xlCellTypeComments)
On Error GoTo 0
If r Is Nothing Then Exit Sub
With Workbooks.Add.Sheets(1).[A1] 'classeur auxiliaire
For Each r In r
s = Split(r.Comment.Text, sep)
If UBound(s) > 1 Then
With .Resize(UBound(s) + 1)
.Value = Application.Transpose(s)
.Sort .Cells, xlAscending, Header:=xlYes
r.Comment.Text Join(Application.Transpose(.Value), sep)
End With
r.Comment.Shape.TextFrame.Characters(Len(s(0)) + 1).Font.Bold = False 'non gras
End If
Next
.Parent.Parent.Close False 'fermeture du classeur auxiliaire
End With
End Sub
Sub TrierCommentaires()
'se lance par Ctrl+T
Dim r As Range, sep$, s, a(), i
Set r = [G:G] 'plage à adapter
sep = vbLf & "- " 'séparateur à adapter
On Error Resume Next 'si aucun commentaire
Set r = r.SpecialCells(xlCellTypeComments)
On Error GoTo 0
If r Is Nothing Then Exit Sub
For Each r In r
s = Split(r.Comment.Text, sep)
If UBound(s) > 1 Then
ReDim a(UBound(s) - 1)
For i = 0 To UBound(a)
If IsNumeric(s(i + 1)) Then a(i) = CDbl(s(i + 1)) Else a(i) = s(i + 1)
Next
tri a, 0, UBound(a)
r.Comment.Text s(0) & sep & Join(a, sep)
r.Comment.Shape.TextFrame.Characters(Len(s(0)) + 1).Font.Bold = False 'non gras
End If
Next
End Sub
Sub tri(a, gauc, droi) ' Quick sort
Dim ref, g, d, temp
ref = a((gauc + droi) \ 2)
g = gauc: d = droi
Do
Do While a(g) < ref: g = g + 1: Loop
Do While ref < a(d): d = d - 1: Loop
If g <= d Then
temp = a(g): a(g) = a(d): a(d) = temp
g = g + 1: d = d - 1
End If
Loop While g <= d
If g < droi Then Call tri(a, g, droi)
If gauc < d Then Call tri(a, gauc, d)
End Sub
Bonjour Etevaldo Santos, le forum,
Sur Win 10 - Excel 2013 j'ai testé avec 40 commentaires (identiques bien sûr) en colonne G.
La macro du post #10 s'exécute en 0,8 seconde, celle du post #11 en 2,6 secondes.
Mais si l'on ajoute Application.ScreenUpdating = False cette dernière s'exécute en 0,3 seconde.
Bonne journée.