Seçili değerlere göre makro ile filitreleme

[Muhammet Okumuş]

Arkadaşlar merhaba,
Bir sütunda yer alan değerlere göre filitreleme yapmak istiyorum.

10.000 satır ve 50 sütun olan tabloda istenilen verileri alabilmek için en hızlı yöntem filitreleme mi, yoksa diziler midir?

 

[programer]

Dosyanız ekte,

makro yerine özet tablo kullandım. Umarım işinize yarar.

 

[Ziynettin]

Merhaba,
Autofiltere göre diziler daha hızlıdır diye biliyorum, sizin ekli dosyanıza göre aşağıdaki kodları test edebilirsiniz.

Autofilter kod,

Sub AutoFilter_Aktar()
Dim Veri As Variant, t As Double
    t = Timer
    Veri = Range("H3", Range("H" & Rows.Count).End(xlUp))
    Veri = Application.Transpose(Veri)
    Veri = Split(Join(Veri, ","), ",")
    Application.ScreenUpdating = False
    Sayfa2.Range("A2:D" & Rows.Count).ClearContents
    Range("B2", Range("B" & Rows.Count).End(xlUp)).AutoFilter 1, Veri, xlFilterValues
    Range("B3", Range("E" & Rows.Count).End(xlUp)).Copy Sayfa2.Range("A65536").End(xlUp)(2)
    Range("B3").AutoFilter
    Application.ScreenUpdating = True
    MsgBox Format(Timer - t, "0.00")
End Sub

Dizi kodu,

Sub Dizi_Aktar()
Dim a(), b(), c(), t As Double
Dim i As Long, x As Long, Say As Long, y As Integer
t = Timer
a = Range("B3:E" & Cells(Rows.Count, 2).End(3).Row)
b = Range("H4:H" & Cells(Rows.Count, 8).End(3).Row)

ReDim c(1 To UBound(a), 1 To UBound(a, 2))

For x = 1 To UBound(b)
    If b(x, 1) <> "" Then
    For i = 1 To UBound(a)
        If a(i, 1) = b(x, 1) Then
            Say = Say + 1
            For y = 1 To UBound(a, 2)
            c(Say, y) = a(i, y)
            Next y
        End If
    Next i
    End If
Next x
            
If Say > 0 Then
    Sayfa2.Range("G2").Resize(Say, UBound(a, 2)) = c
End If

MsgBox Format(Timer - t, "0.00")
End Sub

 

[Muhammet Okumuş]

Sn Ziynettin cevabınız için çok teşekkür ederim. Dizi kodlarını açıklayabilir misiniz? İşin mabntığını çözemedim.