Koşullu veri çekme

[mrtergi66]

Personellerim var birden fazla
ve şantiyelerim var birden fazla

excel içerisinde anaveri sayfasına hangi tarihte
hangi personel hangi şantiyede çalışmış tek tek yazıyorum

fakat bina rapor sayfasında şantiyeyi seçince hangi personelim seçtiğim şantiyede hangi tarihte çalışmış görmek istiyorum

yardımcı olurmusunuz.

ÖRNEK
http://s2.dosya.tc/server5/379vdg/MONTAJ_PLANI__2017_deneme.xls.html

 

[Asri]

Bina rpr nin sayfa kod bölümüne yapıştırın.
Rapor sayfasında B6 da değişiklik olduğunda rapor devreye girer.

Veri giriş yönteminizi çok iyi görmüyorum.
Veri girişlerinizi Tarih, Personel, Şantiye olarak aşağı doğru her gün günlük girerseniz raporlaması daha kolay olur.

Dosya Linktedir.
http://s6.dosya.tc/server9/wvxcq2/MONTAJ_PLANI__2017_deneme.xls.html

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
    If Intersect(Target, Range("B6:B6")) Is Nothing Then Exit Sub
    Call veribul

End Sub


Sub veribul()
   Application.ScreenUpdating = False
   Application.DisplayAlerts = False
   Set shrapor = Sheets("BİNA rpr")
   Set shveri = Sheets("ANAVERİ")
   
   raporsonsatir = shrapor.Cells(Rows.Count, "A").End(3).Row
   shrapor.Range("B8:B" & raporsonsatir).Clear

   raporbina = shrapor.Cells(4, "B").Value
   raporpersonel = shrapor.Cells(6, "B").Value
   
   verisonsutun = shveri.Cells.Find(What:="*", After:=[A2], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
   verisonsatir = shveri.Cells(Rows.Count, "B").End(3).Row
    
   For i = 8 To raporsonsatir
     raportarih = shrapor.Cells(i, "A").Value
     tarihbuldu = False
     For j1 = 3 To verisonsatir
        veritarih = shveri.Cells(j1, "B").Value
        If veritarih = raportarih Then
           tarihbuldu = True
           Exit For
        End If
     Next j1
     peronelbuldu = False
     For j2 = 3 To verisonsutun
        veripersonel = shveri.Cells(2, j2).Value
        If veripersonel = raporpersonel Then
           personelbuldu = True
           Exit For
        End If
     Next j2
     
     If tarihbuldu And personelbuldu And shveri.Cells(j1, j2).Value = raporbina Then
        shrapor.Cells(i, "B").Value = raporpersonel
     End If
     
   Next i
   Application.ScreenUpdating = True
   Application.DisplayAlerts = True
End Sub

 

[mrtergi66]

tesekkur ederım