Hızlı veri süzme.

[desıgner1]

İyi hafta sonları arkadaşlar.

Ekli dosyada ki makroyu dizi mantığı ile kullanmak istiyorum hızlı olsun diye.
Lakin kendim yapamadım. Bu hususta yardımcı olabilir iseniz sevinirim.

 

[N.Ziya Hiçdurmaz]

yanıt

Sub makro()
Dim i As Long, sat As Long

Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Data")

sat = 3

ds = s2.Cells(Rows.Count, "C").End(xlUp).Row
ReDim veri(1 To ds, 1 To 6) As Variant
For i = 5 To ds
 If s2.Cells(i, "D") = s1.Cells(4, "H") _
And s2.Cells(i, "G") = s1.Cells(4, "I") Then

veri(sat, 1) = s2.Cells(i, "C")
veri(sat, 2) = s2.Cells(i, "D")
veri(sat, 3) = s2.Cells(i, "E")
veri(sat, 4) = s2.Cells(i, "F")
veri(sat, 5) = s2.Cells(i, "G")
veri(sat, 6) = s2.Cells(i, "H")
sat = sat + 1
End If: Next i
Sayfa1.Range("k2").Resize(sat, 6) = veri
End Sub

Bu şekil deneyiniz.

 

[desıgner1]

Alakanız için teşekkür ederim.
N.Ziya hocam. Kodu denedim.
Dosyadaki kod ile aynı sürede işlem yapıyor.

 

[Ziynettin]

Merhaba,

Option Explicit
Sub kriter2_aktar()
Dim s1  As Worksheet, s2 As Worksheet, ds As Long
Dim i As Long, sat As Long, say As Long, k As Byte
Dim a(), b(), sH4 As Variant, sI4 As Variant, z As Date
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Data")
sH4 = s1.[H4]: sI4 = s1.[i4]
Application.ScreenUpdating = False
z = TimeValue(Now)
ds = s2.Cells(Rows.Count, "C").End(xlUp).Row
a = s2.Range("C5:H" & ds).Value
    For i = 1 To UBound(a)
        If a(i, 2) = sH4 And a(i, 5) = sI4 Then
            say = say + 1
        End If
    Next i
    s1.Range("K3:P" & Rows.Count).ClearContents
    If say > 0 Then
    ReDim b(1 To say, 1 To UBound(a, 2))
        For i = 1 To UBound(a)
            If a(i, 2) = sH4 And a(i, 5) = sI4 Then
                sat = sat + 1
                For k = 1 To UBound(a, 2)
                    b(sat, k) = a(i, k)
                Next k
            End If
        Next i
        s1.[K3].Resize(sat, 6) = b
    End If
Application.ScreenUpdating = True
MsgBox "İşlem tamam..." & vbLf & "İşlem Süreniz :" & _
            CDate(TimeValue(Now) - z), vbInformation
End Sub

Bu kodu deneyiniz.

 

[desıgner1]

Teşekkür ederim Sayın Ziynettin,
ellerinize sağlık.

 

[Ziynettin]

Teşekkür ederim Sayın Ziynettin,
ellerinize sağlık.

Rica ederim.
İyi çalışmalar.