Koşul Aralığına Göre Veri Çağırma Kod veya Formül Yardımı

[Believing]

Sayın Uzman arkadaşlar,

"A" sütununda 1000 den başlayan ve ardışık sicil numaraları bulunumaktadır. "E" sütununda başlangıç, "F" sütununda bitiş numarası, "G"sütunda personel adı ve "H" sütununda soyadı bulunmaktadır.
"E" ve "F" sütunlarında belirtilen aralık resferans alınarak "A" sütundaki sicil numaralarının karşısına, belirtilen aralık kadar personel adı ve soyadını yazdırmak istiyorum. Detaylı anlatım ekteki örnek çalışmada olup, çözümün formül veya makro ile üretilmesinin önemi yoktur. Elbette her ikisinin olması bilgi açısından nazarımda çok makbule geçecektir.
Konuya hakim uzman arkadaşların çok değerli yardımlarını rica ediyorum.

Saygılarımla,
Ömer Ali ÜZÜMCÜ

Örnek Çalışma Linki:
http://s2.dosya.tc/server8/x7mdgk/ORNEK_BELIEVING_26042019.rar.html

 

[Orion1]

Buyurun.

Sub aktar59()
Dim i As Long, sat As Long, j As Long
Range("B2:C" & Rows.Count).ClearContents
Application.ScreenUpdating = False
For i = 3 To 8
    For j = 2 To Cells(Rows.Count, "A").End(xlUp).Row
        If Cells(j, "A").Value >= Cells(i, "E").Value And _
            Cells(j, "A").Value <= Cells(i, "F").Value Then
                Cells(j, "B").Value = Cells(i, "G").Value
                Cells(j, "C").Value = Cells(i, "H").Value
        End If
    Next j
Next i
Application.ScreenUpdating = True
MsgBox "İşlem bitti"
End Sub

 

[Believing]

Sayın Orion1,

Konuya gözterdiğiniz ilgi ve yardImınız için size çok teşekkür ederim.
ALLAH sizden ve sevdiklerinizden razı olsun. Cuma gününüzü hayırlı ve bereketli eylesin.
Son bir sorum olacak, cevaplamak zorunda değilsiniz.
Referans aldığımız "E3;H8" aralığını Sayfa2'e taşısaydık muvcut kodu nasıl revize ederdik.

Saygılarımla,
Ömer Ali ÜZÜMCÜ

 

[Orion1]

Sayın Orion1,

Konuya gözterdiğiniz ilgi ve yardImınız için size çok teşekkür ederim.
ALLAH sizden ve sevdiklerinizden razı olsun. Cuma gününüzü hayırlı ve bereketli eylesin.
Son bir sorum olacak, cevaplamak zorunda değilsiniz.
Referans aldığımız "E3;H8" aralığını Sayfa2'e taşısaydık muvcut kodu nasıl revize ederdik.

Saygılarımla,
Ömer Ali ÜZÜMCÜ

Sayfa2 diye yeni bir sayfa oluşturun.
Sayfa1 deki verilerinizi sayfa2 de E1 den itibaren yapıştırın.
Aşağıdaki kodlar işinizi görecektir.

Sub aktar59()
Dim i As Long, sat As Long, j As Long, sh As Worksheet
Range("B2:C" & Rows.Count).ClearContents
Application.ScreenUpdating = False
Set sh = Sheets("Sayfa2")
For i = 3 To 8
    For j = 2 To Cells(Rows.Count, "A").End(xlUp).Row
        If Cells(j, "A").Value >= sh.Cells(i, "E").Value And _
            Cells(j, "A").Value <= sh.Cells(i, "F").Value Then
                Cells(j, "B").Value = sh.Cells(i, "G").Value
                Cells(j, "C").Value = sh.Cells(i, "H").Value
        End If
    Next j
Next i
Application.ScreenUpdating = True
MsgBox "İşlem bitti"
End Sub

 

[Believing]

Sayın Orion1,

ALLAH sizden razı olsun.
ALLAH'a emanet olunuz.

Saygılarımla.

 

[Orion1]

Sayın Orion1,

ALLAH sizden razı olsun.
ALLAH'a emanet olunuz.

Saygılarımla.

İyi çalışmalar.