Sayfa2 ye Sayfa1 den Sondan Başa Veri Alma

[akmes]

Selamlar;

Ektede gönderdiğim örnek excel dosyasında da anlaşılacağı gibi, sayfa1 de tüm futbol karşılaşmalarının sonuçları mevcut ben safya2 de A2 satırına bir takım ismi yazdığımda sayfa1 den bu takıma ait son 6 karşılaşmasını sondan başa dökmesini istiyorum.Yardımlarınız için şimdiden çok teşekkür ederim.

 

[Orion1]

dosyanız ektedir.

Option Base 1
Sub bul_59(ByRef takim As String)
'Coder : evrengizlen@hotmail.com
Dim list(), myarr(), sat As Long, i As Long, k As Byte, deg1 As String
Dim deg2 As String, say As Byte
sat = Sheets("sayfa1").Cells(65536, "A").End(xlUp).Row
If sat < 6 Then Exit Sub
takim = UCase(Replace(Replace(takim, "i", "İ"), "ı", "I"))
list = Sheets("Sayfa1").Range("A6:F" & sat).Value
ReDim myarr(1 To 6, 1 To 6)
For i = UBound(list) To LBound(list) Step -1
    deg1 = UCase(Replace(Replace(list(i, 3), "i", "İ"), "ı", "I"))
    deg2 = UCase(Replace(Replace(list(i, 4), "i", "İ"), "ı", "I"))
    If takim = deg1 Or takim = deg2 Then
        say = say + 1
        For k = 1 To 6
            myarr(say, k) = list(i, k)
        Next k
    End If
    If say >= 6 Then Exit For
Next i
Erase list()
Range("A4").Resize(6, 6) = myarr()
Erase myarr()
MsgBox "işlem Tamamlandı." & vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub

 

[akmes]

dosyanız ektedir.

Option Base 1
Sub bul_59(ByRef takim As String)
'Coder : evrengizlen@hotmail.com
Dim list(), myarr(), sat As Long, i As Long, k As Byte, deg1 As String
Dim deg2 As String, say As Byte
sat = Sheets("sayfa1").Cells(65536, "A").End(xlUp).Row
If sat < 6 Then Exit Sub
takim = UCase(Replace(Replace(takim, "i", "İ"), "ı", "I"))
list = Sheets("Sayfa1").Range("A6:F" & sat).Value
ReDim myarr(1 To 6, 1 To 6)
For i = UBound(list) To LBound(list) Step -1
    deg1 = UCase(Replace(Replace(list(i, 3), "i", "İ"), "ı", "I"))
    deg2 = UCase(Replace(Replace(list(i, 4), "i", "İ"), "ı", "I"))
    If takim = deg1 Or takim = deg2 Then
        say = say + 1
        For k = 1 To 6
            myarr(say, k) = list(i, k)
        Next k
    End If
    If say >= 6 Then Exit For
Next i
Erase list()
Range("A4").Resize(6, 6) = myarr()
Erase myarr()
MsgBox "işlem Tamamlandı." & vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub

Hocam elinize emeğinize sağlık,sayfada yanlış yazdığım için de özür dilerim.Sizlerin emeğinizin farkındayız ve ne yapsak hakkınızı ödeyemeyiz.
Saygılarımla,

 

[akmes]

Üstadım valla sıkılarak birşey daha isteyeceğim.Sayfa2 A18 hücresine bir ikinci takım daha tanımlayabilirmiyiz.İki takımı da karşılaştırma imkanımız olur.Şimdiden ilginize ve emeğinize çok teşekkür ederim