Belirli kriterlere göre çıkan veriyi yan sayfaya listeleme

[Suddedly]

Hepinize merhabalar arkadaşlar. Forumda arattım ancak yanlış aratmış olabilirim çünkü bulamadım. Sorunum şu şekilde linkteki dosyada da göreceğiniz üzere bir veri sayfam var bir de yanına rapor sayfası. Yapmak istediğim rapor sayfasında tarih, makina, vardiya gibi kriterleri girdiğimde altında veri sayfasından aldığı verileri listeleyebileyim. Örneği 01.haz tarih - makina 1 vardiya 1 dediğimde o tarihteki o makinanın verilerini getirsin. tabii komple günü görmek istiyorsam vardiyayı boş bıraktığımda ise o güne ait bütün vardiyaları getirsin. Yardımlarınız için şimdiden Allah razı olsun sizlerden. İyi çalışmalar.






http://www.dosya.tc/server8/71xy72/EBATLAMA_2017.xlsx.html

 

[YUSUF44]

Aşağıdaki kodları Rapor sayfasının kod bölümüne yapıştırıp (Rapor sayfa sekmesine sağ tıkla Kod Görüntüle de, açılan sayfaya yapıştır) deneyiniz. Rapor sayfasında B1, B2, E1 ve E2 hücrelerinde değişiklik yaptığınızda ve 4 hücre de doluyken istediğiniz listelemeyi yapar:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B1, B2, E1, E2]) Is Nothing Then Exit Sub
If [B1] <> "" And [B2] <> "" And [E1] <> "" And [E2] <> "" Then
    Set s1 = Sheets("Veri")
    Set s2 = Sheets("Rapor")
    sonsat = s1.Cells(Rows.Count, "A").End(3).Row
    ilk = [B1]
    son = [B2]
    mak = [E1]
    Var = [E2]
    For i = 4 To sonsat
        If s1.Cells(i, "A") >= ilk And s1.Cells(i, "A") <= son And s1.Cells(i, "B") = mak And s1.Cells(i, "C") = Var Then
            yeni = s2.Cells(Rows.Count, "A").End(3).Row + 1
            s1.Range("A" & i & ":Y" & i).Copy s2.Cells(yeni, "A")
        End If
    Next
End If
End Sub

 

[Suddedly]

Çok teşekkür ederim hocam. Peki vardiyayı boş bıraktığımızda o güne ait bütün vardiyaların verilerini nasıl getirtebiliriz peki?

 

[YUSUF44]

İlk kodlar yanlış ve eksik olmuş. aşağıdaki kodları deneyiniz:

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Set s1 = Sheets("Veri")
    Set s2 = Sheets("Rapor")
    sonsat = s1.Cells(Rows.Count, "A").End(3).Row
    ilk = [B1]
    son = [B2]
    mak = [E1]
    vard = [E2]

If Intersect(Target, [B1, B2, E1, E2]) Is Nothing Then Exit Sub
    

If [B1] <> "" And [B2] <> "" And [E1] <> "" And [E2] <> "" Then
    eski = WorksheetFunction.Max(s2.Cells(Rows.Count, "A").End(3).Row, 7)
    s2.Range("A7:Y" & eski).ClearContents
    For i = 4 To sonsat
        If s1.Cells(i, "A") >= ilk And s1.Cells(i, "A") <= son And s1.Cells(i, "B") = mak And s1.Cells(i, "C") = vard Then
            yeni = s2.Cells(Rows.Count, "A").End(3).Row + 1
            s1.Range("D" & i & ":Y" & i).Copy s2.Cells(yeni, "A")
        End If
    Next

ElseIf [B1] <> "" And [B2] <> "" And [E1] <> "" And [E2] = "" Then
    eski = WorksheetFunction.Max(s2.Cells(Rows.Count, "A").End(3).Row, 7)
    s2.Range("A7:Y" & eski).ClearContents
    For i = 4 To sonsat
        If s1.Cells(i, "A") >= ilk And s1.Cells(i, "A") <= son And s1.Cells(i, "B") = mak Then
            yeni = s2.Cells(Rows.Count, "A").End(3).Row + 1
            s1.Range("D" & i & ":Y" & i).Copy s2.Cells(yeni, "A")
        End If
    Next
End If
End Sub

 

[Suddedly]

Tekrar çok teşekkür ederim usta elinize sağlık.

 

[Suddedly]

Yusuf44 hocam tekrar rahatsız ediyorum kusura bakmayın. Ancak raporlamada sarı ile gösterdiğim sütünda m2 yi hesaplarken adedi f ve g deki ölçülerle çarpması gerekirken ısrarla ı ve j sütunlarındaki veriyle çarpıyor. Yardımcı olursanız sevinirim. Çok teşekkürler şimdiden.
Hocam yanındaki m sütunundaki m2 de yine ı ve j den veri alıp çarpıyor. yani 2 yerde hesap hatası yapıyor.


http://www.dosya.tc/server8/57vys2/EBATLAMA_2017.xlsx.html

 

[Suddedly]

Bu hata için yardımcı olacak ustam yok mu acaba?

 

[YUSUF44]

Yazdığım kodlarda formüllere hiçbir şekilde müdahale edilmiyor. Kodlarda yapılan işlemler öncelikle eski veriler siliniyor, sonra girdiğiniz kriterlere göre veri sayfasındaki satırlar kontrol ediliyor, şartlara uyan satır olduğunda o satırın D:Y aralığı rapor sayfasındaki ilk boş satıra KOPYALANIYOR. Kopyalanırken doğal olarak siz nasıl formül ayarlamışsanız aynen o şekilde kopyalanıyor.

Bahsettiğiniz sarı sütundaki formülü incelerseniz

=([COLOR="red"][B]$[/B][/COLOR]I7/100)*([B][COLOR="Red"]$[/COLOR][/B]J7/100)*J7

kırmızı renkli dolar işaretlerini göreceksiniz. O işaretler önünde bulunduğu satır ya da sütunun kopyalama durumunda sabit kalmasını değişmemesini sağlıyor. Eğer veri sayfasındaki ilgili sütunlardaki formüllerde bu dolar işaretlerini silerseniz kopyalama sonucunda formüller de değişen sütun sayısına göre değişecektir.

Bunun sebebi de veri sayfasındaki A, B ve C sütunlarını rapor sayfasına aktarmamamızdır. Eğer o sütunları da kopyalasaydık sütun sayısı değişmeyeceğinden formüller doğru olacaktı.

 

[Suddedly]

O sütunları rapor sayfasında raporlama için parametre olarak kullandığımızdan dolayı getirtmedik hocam. çözümü nasıl olur peki?

 

[YUSUF44]

Yukarda da belirttiğim gibi:

Eğer veri sayfasındaki ilgili sütunlardaki formüllerde bu dolar işaretlerini silerseniz kopyalama sonucunda formüller de değişen sütun sayısına göre değişecektir.