- Initiateur de la discussion apdf1
- Date de début
Boostez vos compétences Excel avec notre communauté !
Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !
Pierrot93
XLDnaute Barbatruc
Re : Filtre
Bonjour,
oui... mais encore....
bonne journée
@+
Bonjour,
oui... mais encore....
bonne journée
@+
Dernière édition:
Re : Filtre
Bonjour Pierrot,
Voila dans ma feuille j'ai une liste de données qui commence a partir de la ligne 6.
Au dessus de cette liste, les lignes "1,2,3 " j'ai des récapitulatifs qui correspond au colonne
la ligne "4" elle on trouve ; nom, adresse etc.. ligne "5" vide.
J'ai un autofiltre et quand je filtre il commence par la ligne2 et moi je voudrais qu'il commence par la ligne 6 ?
Voila si quelqu'un peut m'aider je le remercie d'avance.
Ci joint mon code filtre:
@+
Max
Bonjour Pierrot,
Voila dans ma feuille j'ai une liste de données qui commence a partir de la ligne 6.
Au dessus de cette liste, les lignes "1,2,3 " j'ai des récapitulatifs qui correspond au colonne
la ligne "4" elle on trouve ; nom, adresse etc.. ligne "5" vide.
J'ai un autofiltre et quand je filtre il commence par la ligne2 et moi je voudrais qu'il commence par la ligne 6 ?
Voila si quelqu'un peut m'aider je le remercie d'avance.
Ci joint mon code filtre:
Code:
'Option Explicit
Private Const t As String = "Copyright © A.P.D.F 2010, créer le 31 Août 2010 Max....! "
Private ws As Worksheet
Private Col As Byte, Lig As Integer
Private SearchType As String
Private MemSortieParBouton As Boolean
'Interdire la fermeture par la croix
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If MemSortieParBouton = False Then
MsgBox " Ferme par le bouton " & Chr(13) & "Tcho Biloute"
'Si je met Sa......& chr(13) Sa me permet de changer de ligne
Cancel = True
End If
End Sub
' Quitter
Private Sub CommandButton1_Click()
If Worksheets("Facture").AutoFilterMode Then
Worksheets("Facture").AutoFilterMode = False
End If
[Lance ta procédure d'import]
'MsgBox "A bientôt"
MemSortieParBouton = True
Unload Me
Exit Sub
'& chr(13) te permet de changer de ligne
End Sub
' Bouton retirer filtre
Private Sub CommandButton3_Click()
If Worksheets("Facture").AutoFilterMode Then
Worksheets("Facture").AutoFilterMode = False
End If
[Lance ta procédure d'import]
End Sub
Private Sub ListBox2_Click()
Li = ListBox2.ListIndex
TextBox1 = ListBox2.List(Li, 1) 'colonne1 le 1 correspond a la 2éme colonne
TextBox2 = ListBox2.List(Li, 2) 'colonne2
TextBox3 = ListBox2.List(Li, 3) 'colonne3
TextBox4 = ListBox2.List(Li, 4) 'colonne4
TextBox5 = ListBox2.List(Li, 5) 'colonne5
TextBox6 = ListBox2.List(Li, 6) 'colonne6
TextBox7 = ListBox2.List(Li, 7) 'colonne7
End Sub
Private Sub UserForm_Initialize()
Set ws = ThisWorkbook.Worksheets("Facture")
Me.Caption = t
End Sub
'OptionButton1 Par Ligne
Private Sub OptionButton1_Click()
SearchType = "Par N° Ligne "
ListBox_Criteria 1
End Sub
'OptionButton2 Par N° Facture
Private Sub OptionButton2_Click()
SearchType = "Par N° Facture "
ListBox_Criteria 4
End Sub
'OptionButton3 Par Nom
Private Sub OptionButton3_Click()
SearchType = "Par Nom "
ListBox_Criteria 2
End Sub
Private Sub ListBox_Criteria(C As Byte)
Dim ColFilter As Collection
Dim Plage As Range, Cell As Range
Dim Item As Variant
Dim L As Integer
Me.LblSearchType = SearchType & " pas de Critére défini, clickez sur la ListBox!"
With ws
If .FilterMode = True Then .ShowAllData
End With
Set ColFilter = New Collection
L = ws.Range("B65536").End(xlUp).Row
Col = C
Lig = L
Set Plage = ws.Range(Cells(6, C), Cells(L, C)) ' le 6 represente la 6 eme ligne
Me.ListBox1.Clear
For Each Cell In Plage
On Error Resume Next
ColFilter.Add Cell.Text, Cell.Text
Next
With Me.ListBox1
For Each Item In ColFilter
.AddItem Item
Next
End With
End Sub
Private Sub ListBox1_Click()
Dim TheItem As String
TheItem = CStr(Me.ListBox1.Value)
With ws
If .AutoFilterMode Then
.AutoFilterMode = False
.Range("A5").AutoFilter Col, TheItem
Else
.Range("A5").AutoFilter Col, TheItem
End If
End With
Me.ListBox3.Clear
TabFilter_Create
End Sub
Private Sub TabFilter_Create()
Dim TabFilter() As String
Dim L As Integer
Dim Cell As Range, FilteredRange As Range
Dim i As Integer, x As Integer
Dim ColUnique As Collection
Dim Item As Variant
Me.LblSearchType = SearchType & "Criteria => " & Me.ListBox1
With Sheets(1)
L = .Range("A65536").End(xlUp).Row
Set FilteredRange = .Range("A6:A" & L)
End With
If L = 2 Then GoTo OneLine '!!!
Set FilteredRange = FilteredRange.SpecialCells(xlCellTypeVisible)
ReDim TabFilter(0 To FilteredRange.Count - 1, 0 To 7)
For Each Cell In FilteredRange
TabFilter(i, 0) = Cell.Value
TabFilter(i, 1) = Cell.Offset(0, 1).Value
TabFilter(i, 2) = Cell.Offset(0, 2).Value
TabFilter(i, 3) = Cell.Offset(0, 3).Value
TabFilter(i, 4) = Cell.Offset(0, 4).Value
TabFilter(i, 5) = Cell.Offset(0, 5).Value
TabFilter(i, 6) = Cell.Offset(0, 6).Value
TabFilter(i, 7) = Cell.Offset(0, 7).Value
i = i + 1
Next
With Me.ListBox2
.ColumnCount = 8
.ColumnWidths = "0;15;60;60;45;30;70;60"
.List = TabFilter()
End With
Set ColUnique = New Collection
For x = 0 To UBound(TabFilter, 1)
On Error Resume Next
ColUnique.Add TabFilter(x, 0), TabFilter(x, 0)
Next x
For Each Item In ColUnique
Me.ListBox3.AddItem Item
Next
With Me
.TxbEnregistrements = Lig - 1
.TxbTotalGlobal = i
.TxbTotalUnique = ColUnique.Count
End With
' WS.Range("I5") = ColUnique.Count ' resultat trouvé
Exit Sub
OneLine: 'Si on est sur la première Ligne en unique record il faut un traitement Différent
With Me.ListBox2
.Clear
.ColumnCount = 8
.ColumnWidths = "0;15;60;60;45;30;70;60"
.AddItem ws.Range("A6")
.Column(1, 0) = ws.Range("b6")
.Column(2, 0) = ws.Range("c6")
.Column(3, 0) = ws.Range("d6")
.Column(4, 0) = ws.Range("e6")
.Column(5, 0) = ws.Range("f6")
.Column(6, 0) = ws.Range("g6")
.Column(7, 0) = ws.Range("h6")
End With
With Me
.ListBox3.AddItem ws.Range("B6")
.TxbEnregistrements = Lig - 1
.TxbTotalGlobal = 1
.TxbTotalUnique = 1
End With
' WS.Range("I5") = 1 ' resultat trouvé
End Sub
Private Sub CommandButton2_Click()
ListBox1.Clear
ListBox2.Clear
Dim i As Byte
For i = 1 To 10
ListBox2.AddItem "ListBox Item to drag " _
& (ListBox2.ListCount + 1)
Next i
End Sub@+
Max
Pierrot93
XLDnaute Barbatruc
Re : Filtre
Re,
n'ayant pas 2007 et le filtre étant different dans cette version, je ne pourrais sans doute t'aider plus, mais je t'engage peut être à fournir en pièce jointe un tout petit fichier représentant bien le modèle de donnée... Cela permettra sans doute que l'on t'apporte une solution plus rapidement....
@+
Re,
n'ayant pas 2007 et le filtre étant different dans cette version, je ne pourrais sans doute t'aider plus, mais je t'engage peut être à fournir en pièce jointe un tout petit fichier représentant bien le modèle de donnée... Cela permettra sans doute que l'on t'apporte une solution plus rapidement....
@+
Re : Filtre
Re,
Voila j'ai joint un fichier enregistrer en 2003 sa seras certainement plus parlant.
@+
Max
Re,
Voila j'ai joint un fichier enregistrer en 2003 sa seras certainement plus parlant.
Code:
'Option Explicit
Private Const t As String = "Copyright © A.P.D.F 2010, créer le 31 Août 2010 Max....! "
Private ws As Worksheet
Private Col As Byte, Lig As Integer
Private SearchType As String
Private MemSortieParBouton As Boolean
'Interdire la fermeture par la croix
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If MemSortieParBouton = False Then
MsgBox " Ferme par le bouton " & Chr(13) & "Tcho Biloute"
'Si je met Sa......& chr(13) Sa me permet de changer de ligne
Cancel = True
End If
End Sub
' Quitter
Private Sub CommandButton1_Click()
If Worksheets("Facture").AutoFilterMode Then
Worksheets("Facture").AutoFilterMode = False
End If
[Lance ta procédure d'import]
'MsgBox "A bientôt"
MemSortieParBouton = True
Unload Me
Exit Sub
'& chr(13) te permet de changer de ligne
End Sub
' Bouton retirer filtre
Private Sub CommandButton3_Click()
If Worksheets("Facture").AutoFilterMode Then
Worksheets("Facture").AutoFilterMode = False
End If
[Lance ta procédure d'import]
End Sub
Private Sub ListBox2_Click()
Li = ListBox2.ListIndex
TextBox1 = ListBox2.List(Li, 1) 'colonne1 le 1 correspond a la 2éme colonne
TextBox2 = ListBox2.List(Li, 2) 'colonne2
TextBox3 = ListBox2.List(Li, 3) 'colonne3
TextBox4 = ListBox2.List(Li, 4) 'colonne4
TextBox5 = ListBox2.List(Li, 5) 'colonne5
TextBox6 = ListBox2.List(Li, 6) 'colonne6
TextBox7 = ListBox2.List(Li, 7) 'colonne7
End Sub
Private Sub UserForm_Initialize()
Set ws = ThisWorkbook.Worksheets("Facture")
Me.Caption = t
End Sub
'OptionButton1 Par Ligne
Private Sub OptionButton1_Click()
SearchType = "Par N° Ligne "
ListBox_Criteria 1
End Sub
'OptionButton2 Par N° Facture
Private Sub OptionButton2_Click()
SearchType = "Par N° Facture "
ListBox_Criteria 4
End Sub
'OptionButton3 Par Nom
Private Sub OptionButton3_Click()
SearchType = "Par Nom "
ListBox_Criteria 2
End Sub
Private Sub ListBox_Criteria(C As Byte)
Dim ColFilter As Collection
Dim Plage As Range, Cell As Range
Dim Item As Variant
Dim L As Integer
Me.LblSearchType = SearchType & " pas de Critére défini, clickez sur la ListBox!"
With ws
If .FilterMode = True Then .ShowAllData
End With
Set ColFilter = New Collection
L = ws.Range("B65536").End(xlUp).Row
Col = C
Lig = L
Set Plage = ws.Range(Cells(6, C), Cells(L, C)) ' le 6 represente la 6 eme ligne
Me.ListBox1.Clear
For Each Cell In Plage
On Error Resume Next
ColFilter.Add Cell.Text, Cell.Text
Next
With Me.ListBox1
For Each Item In ColFilter
.AddItem Item
Next
End With
End Sub
Private Sub ListBox1_Click()
Dim TheItem As String
TheItem = CStr(Me.ListBox1.Value)
With ws
If .AutoFilterMode Then
.AutoFilterMode = False
.Range("A5").AutoFilter Col, TheItem
Else
.Range("A5").AutoFilter Col, TheItem
End If
End With
Me.ListBox3.Clear
TabFilter_Create
End Sub
Private Sub TabFilter_Create()
Dim TabFilter() As String
Dim L As Integer
Dim Cell As Range, FilteredRange As Range
Dim i As Integer, x As Integer
Dim ColUnique As Collection
Dim Item As Variant
Me.LblSearchType = SearchType & "Criteria => " & Me.ListBox1
With Sheets(1)
L = .Range("A65536").End(xlUp).Row
Set FilteredRange = .Range("A6:A" & L)
End With
If L = 2 Then GoTo OneLine '!!!
Set FilteredRange = FilteredRange.SpecialCells(xlCellTypeVisible)
ReDim TabFilter(0 To FilteredRange.Count - 1, 0 To 7)
For Each Cell In FilteredRange
TabFilter(i, 0) = Cell.Value
TabFilter(i, 1) = Cell.Offset(0, 1).Value
TabFilter(i, 2) = Cell.Offset(0, 2).Value
TabFilter(i, 3) = Cell.Offset(0, 3).Value
TabFilter(i, 4) = Cell.Offset(0, 4).Value
TabFilter(i, 5) = Cell.Offset(0, 5).Value
TabFilter(i, 6) = Cell.Offset(0, 6).Value
TabFilter(i, 7) = Cell.Offset(0, 7).Value
i = i + 1
Next
With Me.ListBox2
.ColumnCount = 8
.ColumnWidths = "0;15;60;60;45;30;70;60"
.List = TabFilter()
End With
Set ColUnique = New Collection
For x = 0 To UBound(TabFilter, 1)
On Error Resume Next
ColUnique.Add TabFilter(x, 0), TabFilter(x, 0)
Next x
For Each Item In ColUnique
Me.ListBox3.AddItem Item
Next
With Me
.TxbEnregistrements = Lig - 1
.TxbTotalGlobal = i
.TxbTotalUnique = ColUnique.Count
End With
' WS.Range("I5") = ColUnique.Count ' resultat trouvé
Exit Sub
OneLine: 'Si on est sur la première Ligne en unique record il faut un traitement Différent
With Me.ListBox2
.Clear
.ColumnCount = 8
.ColumnWidths = "0;15;60;60;45;30;70;60"
.AddItem ws.Range("A6")
.Column(1, 0) = ws.Range("b6")
.Column(2, 0) = ws.Range("c6")
.Column(3, 0) = ws.Range("d6")
.Column(4, 0) = ws.Range("e6")
.Column(5, 0) = ws.Range("f6")
.Column(6, 0) = ws.Range("g6")
.Column(7, 0) = ws.Range("h6")
End With
With Me
.ListBox3.AddItem ws.Range("B6")
.TxbEnregistrements = Lig - 1
.TxbTotalGlobal = 1
.TxbTotalUnique = 1
End With
' WS.Range("I5") = 1 ' resultat trouvé
End Sub
Private Sub CommandButton2_Click()
ListBox1.Clear
ListBox2.Clear
Dim i As Byte
For i = 1 To 10
ListBox2.AddItem "ListBox Item to drag " _
& (ListBox2.ListCount + 1)
Next i
End Sub@+
Max
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Discussions similaires
- Question
- Question
