XL 2010 Problèmes filtre automatique multiple sur plus de 10 000 lignes

Private Sub Label3_Click()
Dim d As Object, i&, P As Range, t, affiche As Range
Set d = CreateObject("Scripting.Dictionary")
With ListBox1
    For i = 0 To .ListCount - 1
        If .Selected(i) Then d(.List(i, 0)) = ""
    Next
End With
Set P = [A2:A300001]
t = P 'matrice, plus rapide
For i = 1 To UBound(t)
    If d.exists(t(i, 1)) Then Set affiche = Union(IIf(affiche Is Nothing, P(i), affiche), P(i))
Next
Application.ScreenUpdating = False
P.Rows.Hidden = True 'masque toute les lignes
If Not affiche Is Nothing Then affiche.Rows.Hidden = False 'affiche les valeurs sélectionnées
Application.ScreenUpdating = True
End Sub

Private Sub UserForm_Initialize()
Dim t, d As Object, i&, a, b
t = [A2:A300001] 'matrice, plus rapide
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(t)
    d(t(i, 1)) = d(t(i, 1)) + 1 'comptage
Next
a = d.keys: b = d.items
ReDim t(UBound(a), 1)
For i = 0 To UBound(t)
    t(i, 0) = a(i)
    t(i, 1) = b(i)
Next
ListBox1.List = t
End Sub

Private Sub ComboBox1_GotFocus()
  Set d = CreateObject("Scripting.Dictionary")
  For Each c In Range([A4], [A65000].End(xlUp))
    If Not d.Exists(c.Value) Then d(c.Value) = ""
  Next c
  temp = d.keys
  tri temp, LBound(temp), UBound(temp)
Me.ComboBox1.List = temp
End Sub

Private Sub ComboBox1_Change()
   [A3].AutoFilter field:=1, Criteria1:=ComboBox1
End Sub

Dim a()
Private Sub ComboBox1_GotFocus()
  Set d = CreateObject("Scripting.Dictionary")
  For Each c In Range([A4], [A65000].End(xlUp))
    If Not d.Exists(c.Value) Then d(c.Value) = ""
  Next c
  a = d.keys
  Tri a, LBound(a), UBound(a)
  Me.ComboBox1.List = a
End Sub

Private Sub ComboBox1_Change()
  If Me.ComboBox1 <> "" Then
    Set d1 = CreateObject("Scripting.Dictionary")
    tmp = UCase(Me.ComboBox1) & "*"
    For Each c In a
      If UCase(c) Like tmp Then d1(c) = ""
    Next c
    Me.ComboBox1.List = d1.keys
    Me.ComboBox1.DropDown
  End If
End Sub

Private Sub ComboBox1_click()
   [A3].AutoFilter field:=1, Criteria1:=ComboBox1
End Sub