Tablodan otomatik veri listeleme

[yusuf.sak]

Mrb.

Bir tablo halindeki listeden belli kriterlere göre otomatik olarak tek bir liste oluşturulabilirmi.

Ekteki dosyada belirtilen kriterlere göre bu listeyi yazırlayabilirmiyiz.

Yardımlarınız için şimdiden teşekkür ederim.

 

[Necdet]

Merhaba,

Dosyayı inceleyiniz.

Public Sub Aktar()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Rapor")
Application.ScreenUpdating = False
s1.Select
s2.[A2:G65536].ClearContents
Tar1 = [J1]
Tar2 = [K1]
Ay1 = [M1]
Ay2 = [N1]
Satır = 1
For i = 2 To [A65536].End(3).Row
    If Cells(i, "F") < Tar1 Then GoTo Devam
    If Cells(i, "F") > Tar2 Then GoTo Devam
    If Month(Cells(i, "G")) < Ay1 Then GoTo Devam
    If Month(Cells(i, "G")) > Ay2 Then GoTo Devam
    
    Satır = Satır + 1
    Range("A" & i & ":G" & i).Copy s2.Cells(Satır, "A")
Devam:
Next i
Tar1 = [J2]
Tar2 = [K2]
Ay1 = [M2]
Ay2 = [N2]
For i = 2 To [A65536].End(3).Row
    If Cells(i, "F") < Tar1 Then GoTo Devam1
    If Cells(i, "F") > Tar2 Then GoTo Devam1
    If Month(Cells(i, "G")) < Ay1 Then GoTo Devam1
    If Month(Cells(i, "G")) > Ay2 Then GoTo Devam1
    
    Satır = Satır + 1
    Range("A" & i & ":G" & i).Copy s2.Cells(Satır, "A")
Devam1:
Next i
If Satır > 1 Then
    MsgBox Satır - 1 & " Adet Kayıt Bulundu ve Aktarıldı...."
Else
    MsgBox "Aktarılacak Veri Bulunamamıştır ...."
End If
End Sub

 

[SanaLSukuL]

Sn. Necdet_Yesertener aktarım yaparken bulduğu bilgileri silip diğer sayfaya aktarsa, bu tür bir işlem yapmak için ne yapmalıyız kodlarda.
Elinize sağlık güzel bir çalışma ama birde silip diğer sayfaya aktarsa mükemmel olacak.
Saygılar...

 

[SanaLSukuL]

bulduğu verileri sayfa2 deki verileri silip üstüne yazıyor keşke sayfa2 deki verileri silmeyip boş olan satıra yazsa daha güzel bir uygulama olacakmış. benimde böyle bir çalışmam var da bu iyi bir örnek oldu.
Emeğinize sağlık.

 

[Necdet]

Sayın SanaLSukuL soruyu öyle anladığım için o şekilde yaptım, program yazma tekniği içinde aslında pek iyi olmadı, hızlı yanıttan kaynaklanıyor

Ama sizin istediğiniz şekilde de olur, neden olmasın.

 

[SanaLSukuL]

Sn. Necdet_Yesertener eğer sayfa birden istenilen verileri silip sayfa2 ye aktarabilirsek ama diğer 2. aramada da istenilen verileri silip sayfa 2 deki verilerin üstüne değilde en alttaki boş olan satıra aktarabilen makroyu veya formu düzenlerseniz minnettar kalırım 5 gündür bunun la uğraşıyorum olmadı

 

[yusuf.sak]

Mrb. arkadaşım.
Elerine sağlık çok güzel olmuş.tam istediğim gibi.
sağol,varol.

 

[Necdet]

Sn. Necdet_Yesertener eğer sayfa birden istenilen verileri silip sayfa2 ye aktarabilirsek ama diğer 2. aramada da istenilen verileri silip sayfa 2 deki verilerin üstüne değilde en alttaki boş olan satıra aktarabilen makroyu veya formu düzenlerseniz minnettar kalırım 5 gündür bunun la uğraşıyorum olmadı

Şarta uyan verileri aktarırken birinci sayfadan silinmesini istiyorsunuz onu anladım. Ama devamını anlamadım

Ben ikinci şarttaki bilgileride zaten ikinci sayfanın sonuna eklettirdim üstüne yazdırmadım.

 

[SanaLSukuL]

Sn. Necdet_Yesertener sayfa1 den arattardım veriyi buldu ama sayfa2deki verilerin üstüne yazdı en alttaki boş satıra yazdırmadı. Eğer dolu satırlara değilde boş satırlara aktarıyorsa mükemmle ben biraz kafayı yedim de 5 gündür bu sil ama diğer sayfada alt alta akatarla uğraşıyorum yani bir arşivleme gibi bir işlem kusura bakmayın .
Şu silipte diğer sayafaya her aktar değimizde boş satırı bulup aktaran kodu veya örnek bir çalışmayı yollarsanız sevinirim.
Dosya örneği aktedir.

 

[Necdet]

Merhaba,

Umarım sorununuzu anlamışımdır. Ekteki örnekte şarta bağlı olan satırları 2. sayfada ilk boş hücreyi bulup aktardıktan sonra siliyor.

 

[Necdet]

Merhaba,

Başka yöntemlerle de yapılabilir, dosya yapısı değişebilir.
Hem mazi hem data sayfalarında koşullu biçimlendirme yaptım.

Public Sub Bilgi_Aktar_Sil()
Set s1 = Sheets("data")
Set s2 = Sheets("mazi")
s1.Select
On Error Resume Next
Bul = 0
Bul = Range("D3:D103").Find([I4]).Row
If Bul = 0 Then Exit Sub
SonSat = s2.[C65536].End(3).Row + 1
s2.Cells(SonSat, "C") = Cells(Bul, "D")
s2.Cells(SonSat, "D") = Cells(Bul, "E")
s2.Cells(SonSat, "E") = Cells(Bul, "F")
s2.Cells(SonSat, "F") = Cells(Bul, "G")
Rows(Bul).Delete
End Sub

 

[SanaLSukuL]

Sn. Necdet_Yesertener elinize sağlık çook tşk ederim

 

[gurcan21]

elinize sağlık güzel çalışma