Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, [B4]) Is Nothing Then Exit Sub
Cancel = True
With Sheets("Donnée").[A:C]
.Cells(2, 5) = "=COUNTIF(B:B,B2)>1" 'critère
.AdvancedFilter xlFilterInPlace, .Cells(1, 5).Resize(2) 'filtre avancé
.Cells(2, 5) = ""
.Parent.Activate
End With
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, [B4]) Is Nothing Then Exit Sub
Cancel = True
With Sheets("Donnée").[A:C]
.Cells(2, 5) = "=COUNTIF(B:B,B2)>1" 'critère
.AdvancedFilter xlFilterInPlace, .Cells(1, 5).Resize(2) 'filtre avancé
.Cells(2, 5) = ""
.Parent.Activate
End With
End Sub
bonjourBonjour phddesi,
Voyez le fichier joint, la formule en B4 et la macro :
La dernière question n'est pas claire, montrez le résultat à obtenir.VB:Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Intersect(Target, [B4]) Is Nothing Then Exit Sub Cancel = True With Sheets("Donnée").[A:C] .Cells(2, 5) = "=COUNTIF(B:B,B2)>1" 'critère .AdvancedFilter xlFilterInPlace, .Cells(1, 5).Resize(2) 'filtre avancé .Cells(2, 5) = "" .Parent.Activate End With End Sub
A+
Sub Tri_croissant()
Dim ncol%, i&, a&(), n&
Application.ScreenUpdating = False
With [Base].ListObject.Range
If .Parent.FilterMode Then .Parent.ShowAllData 'si la feuille est filtrée
ncol = .Columns.Count
For i = 2 To .Rows.Count
If .Cells(i, 1).Interior.ColorIndex = 6 Then 'couleur jaune
ReDim Preserve a(n) 'base 0
a(n) = i 'mémorise la ligne
.Rows(i).Cut .Cells(i, ncol + 2)
n = n + 1
End If
Next
'---restitution---
If n = 0 Then Exit Sub
.Sort .Columns(1), xlAscending, Header:=xlYes 'tri croissant
For i = 0 To UBound(a)
.Rows(a(i)).Insert xlDown
.Cells(a(i), ncol + 2).Resize(, ncol).Cut .Rows(a(i))
Next
.Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete 'supprime les lignes vides
.Parent.Activate
End With
End Sub
Bonjour phddesi,
Voyez le fichier joint, la formule en B4 et la macro :
La dernière question n'est pas claire, montrez le résultat à obtenir.VB:Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Intersect(Target, [B4]) Is Nothing Then Exit Sub Cancel = True With Sheets("Donnée").[A:C] .Cells(2, 5) = "=COUNTIF(B:B,B2)>1" 'critère .AdvancedFilter xlFilterInPlace, .Cells(1, 5).Resize(2) 'filtre avancé .Cells(2, 5) = "" .Parent.Activate End With End Sub
A+
Le filtrage par couleur est classique, voyez ce fichier (3) :je veux un filtre pour garder que sur les lignes jaunes
Sub Filtre_couleur()
With [Base].ListObject.Range
.AutoFilter 1, RGB(255, 255, 0), Operator:=xlFilterCellColor
.Parent.Activate
End With
End Sub