La mia lunghissima tabella in excel ha quattro colonne di dati da filtrare, O, R, U, X
Sopra ai dati ho quattro chiavi di ricerca: N6, N8, X6, X8
in più ho un tastino in U7 con il comando Clear all filters.
Succede che quando vado a digitare la parola chiave dentro alla cella predisposta, la digitazione salta alla cella A10 (10 è la riga che contiene tutte le etichette delle colonne): non c'è verso, mettiamo che voglia cercare il prodotto "computer" nella cella destinata alla chiave di ricerca ci va solo la "c", il resto salta a scrivere di là. Premesso che il lavoro l'ho ereditato e quindi non sono io l'autore della macro, è più semplice per voi darmi la macro giusta da tutto inizio? Io intanto la copio qui sotto.... a me sembra terribile....
- Codice: Seleziona tutto
Option Explicit
Dim wsMaster As Worksheet
Dim MyList() As String
Dim iRow As Integer
Const cSegCol As Integer = 2, cFamCol As Integer = 4, cClaCol As Integer = 6, cBriCol As Integer = 7
Private Sub btnClearAll_Click()
If AutoFilterMode = True Then Selection.AutoFilter
If AutoFilterMode = True Then Selection.AutoFilter
Range(Cells(10, 1), Cells(10, 32)).AutoFilter
cboSeg.Value = ""
cboFam.Value = ""
cboCla.Value = ""
cboBri.Value = ""
Selection.AutoFilter Field:=15
Selection.AutoFilter Field:=18
Selection.AutoFilter Field:=21
Selection.AutoFilter Field:=24
End Sub
Private Sub cboBri_Change()
On Error Resume Next
ActiveSheet.Cells(10, 1).Select
ActiveSheet.Cells(10, 1).Select
If (ActiveSheet.cboBri.Text = "") Then
Selection.AutoFilter Field:=24
Else
Selection.AutoFilter Field:=24, Criteria1:=ActiveSheet.cboBri.Text
End If
End Sub
Private Sub cboCla_Change()
On Error Resume Next
ActiveSheet.Cells(10, 1).Select
If (ActiveSheet.cboCla.Text = "") Then
Selection.AutoFilter Field:=21
Else
Selection.AutoFilter Field:=21, Criteria1:=ActiveSheet.cboCla.Text
End If
Selection.AutoFilter Field:=24
Remplir_Combo Sheet11, ActiveSheet.cboBri, 24, 11
Trie (cboBri)
End Sub
Private Sub cboFam_Change()
On Error Resume Next
ActiveSheet.Cells(10, 1).Select
If (ActiveSheet.cboFam.Text = "") Then
Selection.AutoFilter Field:=18
Else
Selection.AutoFilter Field:=18, Criteria1:=ActiveSheet.cboFam.Text
End If
Selection.AutoFilter Field:=21
Selection.AutoFilter Field:=24
Remplir_Combo Sheet11, ActiveSheet.cboCla, 21, 11
Remplir_Combo Sheet11, ActiveSheet.cboBri, 24, 11
Trie (cboCla)
End Sub
Private Sub cboSeg_Change()
On Error Resume Next
ActiveSheet.Cells(10, 1).Select
If (ActiveSheet.cboSeg.Text = "") Then
Selection.AutoFilter Field:=15
Else
Selection.AutoFilter Field:=15, Criteria1:=ActiveSheet.cboSeg.Text
End If
Selection.AutoFilter Field:=18
Selection.AutoFilter Field:=21
Selection.AutoFilter Field:=24
Remplir_Combo Sheet11, ActiveSheet.cboFam, 18, 11
Remplir_Combo Sheet11, ActiveSheet.cboCla, 21, 11
Remplir_Combo Sheet11, ActiveSheet.cboBri, 24, 11
Trie (cboFam)
End Sub
Sub Filter(Col As Integer)
If cboSeg.Value <> "" Or cboFam.Value <> "" Or _
cboCla.Value <> "" Or cboBri.Value <> "" Then
Cells(11, 1).Select
Select Case Col
Case 1
cboSeg.Value = ""
cboFam.Value = ""
cboCla.Value = ""
cboBri.Value = ""
Selection.AutoFilter Field:=8
Selection.AutoFilter Field:=6
Selection.AutoFilter Field:=4
Selection.AutoFilter Field:=2
Case cSegCol
Selection.AutoFilter Field:=2
Selection.AutoFilter Field:=4
Selection.AutoFilter Field:=6
Selection.AutoFilter Field:=8
Selection.AutoFilter Field:=2, Criteria1:=cboSeg.Value
Case cFamCol
Selection.AutoFilter Field:=2
Selection.AutoFilter Field:=4
Selection.AutoFilter Field:=5
Selection.AutoFilter Field:=8
Selection.AutoFilter Field:=4, Criteria1:=cboFam.Value
Case cClaCol
Selection.AutoFilter Field:=2
Selection.AutoFilter Field:=4
Selection.AutoFilter Field:=6
Selection.AutoFilter Field:=8
Selection.AutoFilter Field:=6, Criteria1:=cboCla.Value
Case cBriCol
Selection.AutoFilter Field:=2
Selection.AutoFilter Field:=4
Selection.AutoFilter Field:=6
Selection.AutoFilter Field:=8
Selection.AutoFilter Field:=8, Criteria1:=cboBri.Value
End Select
End If
End Sub
Sub Remplir_Combo(fFeuil, fobjet, fColonne, fLigne)
Dim wValeur As String
Dim wErreur As Integer
Dim i As Integer
'INITALISATION
fFeuil.Visible = True
fFeuil.Select
fobjet.Clear
fobjet.AddItem ""
wValeur = ""
'REMPLISSAGE COMBO TANT QUE <> ""
Do
If (ActiveSheet.Cells(fLigne, fColonne).EntireRow.Hidden = True Or ActiveSheet.Cells(fLigne, fColonne).Value = wValeur Or ActiveSheet.Cells(fLigne, fColonne).Value = "") Then
Else
wErreur = 0
i = 0
Do While (i < fobjet.ListCount)
If (fobjet.Column(0, i) = ActiveSheet.Cells(fLigne, fColonne).Value) Then
wErreur = 1
End If
i = i + 1
Loop
If (wErreur = 0) Then
fobjet.AddItem ActiveSheet.Cells(fLigne, fColonne).Value
wValeur = ActiveSheet.Cells(fLigne, fColonne).Value
End If
End If
fLigne = fLigne + 1
Loop While (fLigne <= ActiveSheet.Cells(1, 1).Value)
'TEST POUR L'OUVERTURE
If fobjet.ListCount <> 0 Then
'fobjet.Value = fobjet.Column(0, 0)
End If
End Sub
Sub Trie(fobjet)
Dim i As Byte, j As Byte
Dim temp As String
With fobjet
For i = 0 To .ListCount - 1
For j = 0 To .ListCount - 1
If .List(i) < .List(j) Then
temp = .List(i)
.List(i) = .List(j)
.List(j) = temp
End If
Next j
Next i
End With
End Sub
Sub Load_Feuille(fFeuille)
If AutoFilterMode = True Then Selection.AutoFilter
If AutoFilterMode = True Then Selection.AutoFilter
Range(Cells(10, 1), Cells(10, 32)).AutoFilter
cboSeg.Value = ""
cboFam.Value = ""
cboCla.Value = ""
cboBri.Value = ""
Remplir_Combo fFeuille, ActiveSheet.cboSeg, 15, 11
Remplir_Combo fFeuille, ActiveSheet.cboFam, 18, 11
Remplir_Combo fFeuille, ActiveSheet.cboCla, 21, 11
Remplir_Combo fFeuille, ActiveSheet.cboBri, 24, 11
Trie (ActiveSheet.cboSeg)
' If AutoFilterMode = True Then Selection.AutoFilter
' Range(Cells(11, 1), Cells(11, 31)).AutoFilter
'Remplir_Donnees cboSeg, 1, 15
'Remplir_Donnees cboFam, 2, 18
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
End Sub