• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Makro ile tarihleri ayıklama

  • Konbuyu başlatan Konbuyu başlatan ormann
  • Başlangıç tarihi Başlangıç tarihi
O

ormann

Katılım
9 Ekim 2009
Mesajlar
1,626
Excel Vers. ve Dili
türkçe
2003
Sayın arkadaşlar ekteki örnek dosyamda suç kaydı bölümünde "aq "hücresinde duruşma tarihleri var.ana sayfamda bulunan 4 adet buton yardımıyla bugünkü duruşmalar butonuna bastığımda suç kaydı sayfasından bugünkü duruşma tarihlerini ve istenilen sütunları seçip makro ile duruşmalar sayfasına gönderebilirmiyiz.yine yarınki duruşmalar butonunu tıkladığımda suç kaydı sayfasından yarınki druşmaları ayıklayıp istenilen sutunları aynı şekilde duruşmalar sayfasına aktarabilirmiyiz.yine bu haftaki duruşmalar butonunu tıkladığımda suç kaydı sayfasından bu haftaki duruşmaları seçip istenilen sutunları duruşmalar sayfasına aktarabilirmiyiz.yine son butonda ise bu ayki duruşmlar butonunu tıkladığımızda ise suç kaydı sayfasından bu ayki duruşmaları seçip istenilen sutunları durşmalar sayfasına makro ile aktarabilirmiyiz.not:aktarma yaparken bir öceki aktarılanlar silinecek
sayın hocalarımn biraz zor ve uğraştırıcı bir şey istiyorum.yardımcı olurmusunuz.saygılar.
 

Ekli dosyalar

Merhaba Ekteki formulleri denermisiniz.


Kod: 
Sub Bugun()
Set s1 = Sheets("SUÇ KAYDI")
Set s2 = Sheets("DURUŞMALAR")
s2.Select
s2.Range("A2:L1000").ClearComments
s1.Select
For i = 2 To s1.Range("A65536").End(3).Row
aa = Format(s1.Cells(i, "AQ").Value, "dd.mm.yyyy")
bb = Format(Date, "dd.mm.yyyy")
If aa = bb Then
s2.Select
sonsat = s2.Range("A65536").End(3).Row + 1
s2.Cells(sonsat, "A").Value = s1.Cells(i, "AQ").Value
s2.Cells(sonsat, "B").Value = s1.Cells(i, "A").Value
s2.Cells(sonsat, "C").Value = s1.Cells(i, "B").Value
s2.Cells(sonsat, "D").Value = s1.Cells(i, "C").Value
s2.Cells(sonsat, "E").Value = s1.Cells(i, "D").Value
s2.Cells(sonsat, "F").Value = s1.Cells(i, "E").Value
s2.Cells(sonsat, "G").Value = s1.Cells(i, "F").Value
s2.Cells(sonsat, "H").Value = s1.Cells(i, "Q").Value
s2.Cells(sonsat, "I").Value = s1.Cells(i, "AR").Value
s2.Cells(sonsat, "J").Value = s1.Cells(i, "BW").Value
s2.Cells(sonsat, "K").Value = s1.Cells(i, "BX").Value
s2.Cells(sonsat, "L").Value = s1.Cells(i, "AP").Value
End If
Next
End Sub

Sub Yarın()
Set s1 = Sheets("SUÇ KAYDI")
Set s2 = Sheets("DURUŞMALAR")
s2.Select
s2.Range("A2:L1000").ClearComments
s1.Select
For i = 2 To s1.Range("A65536").End(3).Row
aa = Format(s1.Cells(i, "AQ").Value, "dd.mm.yyyy")
bb = Format(Date + 1, "dd.mm.yyyy")
If aa = bb Then
s2.Select
sonsat = s2.Range("A65536").End(3).Row + 1
s2.Cells(sonsat, "A").Value = s1.Cells(i, "AQ").Value
s2.Cells(sonsat, "B").Value = s1.Cells(i, "A").Value
s2.Cells(sonsat, "C").Value = s1.Cells(i, "B").Value
s2.Cells(sonsat, "D").Value = s1.Cells(i, "C").Value
s2.Cells(sonsat, "E").Value = s1.Cells(i, "D").Value
s2.Cells(sonsat, "F").Value = s1.Cells(i, "E").Value
s2.Cells(sonsat, "G").Value = s1.Cells(i, "F").Value
s2.Cells(sonsat, "H").Value = s1.Cells(i, "Q").Value
s2.Cells(sonsat, "I").Value = s1.Cells(i, "AR").Value
s2.Cells(sonsat, "J").Value = s1.Cells(i, "BW").Value
s2.Cells(sonsat, "K").Value = s1.Cells(i, "BX").Value
s2.Cells(sonsat, "L").Value = s1.Cells(i, "AP").Value
End If
Next
End Sub


Sub Hafta()
Set s1 = Sheets("SUÇ KAYDI")
Set s2 = Sheets("DURUŞMALAR")
s2.Select
s2.Range("A2:L1000").ClearComments
s1.Select
For i = 2 To s1.Range("A65536").End(3).Row
aa = Format(s1.Cells(i, "AQ").Value, "dd.mm.yyyy")
bb = Format(Date, "dd.mm.yyyy")
cc = Format(Date + 7, "dd.mm.yyyy")
If aa >= bb And aa <= cc Then
s2.Select
sonsat = s2.Range("A65536").End(3).Row + 1
s2.Cells(sonsat, "A").Value = s1.Cells(i, "AQ").Value
s2.Cells(sonsat, "B").Value = s1.Cells(i, "A").Value
s2.Cells(sonsat, "C").Value = s1.Cells(i, "B").Value
s2.Cells(sonsat, "D").Value = s1.Cells(i, "C").Value
s2.Cells(sonsat, "E").Value = s1.Cells(i, "D").Value
s2.Cells(sonsat, "F").Value = s1.Cells(i, "E").Value
s2.Cells(sonsat, "G").Value = s1.Cells(i, "F").Value
s2.Cells(sonsat, "H").Value = s1.Cells(i, "Q").Value
s2.Cells(sonsat, "I").Value = s1.Cells(i, "AR").Value
s2.Cells(sonsat, "J").Value = s1.Cells(i, "BW").Value
s2.Cells(sonsat, "K").Value = s1.Cells(i, "BX").Value
s2.Cells(sonsat, "L").Value = s1.Cells(i, "AP").Value
End If
Next
End Sub

Sub AY()
Set s1 = Sheets("SUÇ KAYDI")
Set s2 = Sheets("DURUŞMALAR")
s2.Select
s2.Range("A2:L1000").ClearComments
s1.Select
For i = 2 To s1.Range("A65536").End(3).Row
aa = Format(s1.Cells(i, "AQ").Value, "mm")
bb = Format(Date, "mm")
If aa = bb Then
s2.Select
sonsat = s2.Range("A65536").End(3).Row + 1
s2.Cells(sonsat, "A").Value = s1.Cells(i, "AQ").Value
s2.Cells(sonsat, "B").Value = s1.Cells(i, "A").Value
s2.Cells(sonsat, "C").Value = s1.Cells(i, "B").Value
s2.Cells(sonsat, "D").Value = s1.Cells(i, "C").Value
s2.Cells(sonsat, "E").Value = s1.Cells(i, "D").Value
s2.Cells(sonsat, "F").Value = s1.Cells(i, "E").Value
s2.Cells(sonsat, "G").Value = s1.Cells(i, "F").Value
s2.Cells(sonsat, "H").Value = s1.Cells(i, "Q").Value
s2.Cells(sonsat, "I").Value = s1.Cells(i, "AR").Value
s2.Cells(sonsat, "J").Value = s1.Cells(i, "BW").Value
s2.Cells(sonsat, "K").Value = s1.Cells(i, "BX").Value
s2.Cells(sonsat, "L").Value = s1.Cells(i, "AP").Value
End If
Next
End Sub
 
Sayın hüseyin istedim gibi olmuş.yalnız ikinci bir günü aktardığımda diğer günün devamına aktarıyo.acaba ilk aktardığımızı silip üzerine aktarabilirmi.
 
ormann' Alıntı:
Sayın hüseyin istedim gibi olmuş.yalnız ikinci bir günü aktardığımda diğer günün devamına aktarıyo.acaba ilk aktardığımızı silip üzerine aktarabilirmi.
Genişletmek için tıkla ...

Normalde aktarmaması gerekiyor fakat sanırım dosya sayıları 1000 den fazla:)

s2.Range("A2:L1000").ClearComments

kısımlarını

s2.Range("A2:L65536").ClearComments olarak değiştirin.
 
Huseyinkis' Alıntı:
Normalde aktarmaması gerekiyor fakat sanırım dosya sayıları 1000 den fazla:)

s2.Range("A2:L1000").ClearComments

kısımlarını

s2.Range("A2:L65536").ClearComments olarak değiştirin.
Genişletmek için tıkla ...


Pardon clear kısmını karıştırmışım..

s2.Range("A2:L65536").ClearContents Comments ile karışmış. yapın
 
Sayın hocam birde aktardıktan sonra ana sayfaya dönebilirmi
 
bugünkü için makro kaydetmeye başla. satır 2'den başla 200-300 satır sil. suç kaydı sayfasına git. bugünkü duruşmaları süz. kopyala ve duruşma sayfasına kopyala. suç kaydından süzmeyi kaldır. yani tümünü seç. makroyu durdur. makroyu düzenlemek için aç. süzme için auto filter benzeri bir komut göreceksin. orada criteria var. orayı date yap. bu makroyu istediğin düğmeye ata. aslında makroyu bu düğmeyede atayabilirsin. istersen düğmeye tasarım modunda çift tıklayıp vb düzenleyicisinde application.run("makro1") yazarak da kaydettiğin makroyu çalıştırabilirsin. makro1 ismi örnektir. kaydettiğin makronun adı. diğer seçenekler içinse aynı yolu uygula. ay ve hafta için süzde özel girip büyük ve küçüktür için iki tarih belirle. sonra criteria dan bu tarihleri date artı 7 (hafta için) değiştir. syagılar esenlikler. biraz uzun oldu ama kendin yapabilirsin diye yazdım.
 
ormann' Alıntı:
Sayın hocam birde aktardıktan sonra ana sayfaya dönebilirmi
Genişletmek için tıkla ...

s2.Cells(sonsat, "L").Value = s1.Cells(i, "AP").Value
End If
Next

yukarıdaki next in altına

Sheets("ANA SAYFA").select yazın aşağıdaki gibi olsun sonu.

s2.Cells(sonsat, "L").Value = s1.Cells(i, "AP").Value
End If
Next
Sheets("ANA SAYFA").select
end sub
 
Sayın hocam son olarakta tüm duruşmalar olarakta aktarma olabilirmi saygılar.seneyi duruşma tarihini bir sonraki yıl olarak seçtiğimde göstermiyo.birde aktarıldıktan sonra tarih sıralaması yapılabilirmi
 
Son düzenleme:
Sayın hocam son olarakta tüm duruşmalar olarakta aktarma olabilirmi saygılar.seneyi duruşma tarihini bir sonraki yıl olarak seçtiğimde göstermiyo.birde aktarıldıktan sonra tarih sıralaması yapılabilirmi
 
Son düzenleme:
ormann' Alıntı:
Sayın hocam son olarakta tüm duruşmalar olarakta aktarma olabilirmi saygılar.seneyi duruşma tarihini bir sonraki yıl olarak seçtiğimde göstermiyo.birde aktarıldıktan sonra tarih sıralaması yapılabilirmi
Genişletmek için tıkla ...

Hepsi için ekteki formulu kullanabilirsiniz. if msgbox la başlayan kısmı diğerlerinede uygularsanız aktarmadan once onay isteyecektir. Sıralama için şimdilik excel sırala seçeneğini kullanırsanız daha sonra onuda yapmaya çalışırım.

iyi Çalışmalar

Kod: 
Sub Hepsi()
If MsgBox("Dosya aktarılacak onaylıyor musunuz ?", vbCritical + vbYesNo, "Dikkat !") = vbYes Then

Set s1 = Sheets("SUÇ KAYDI")
Set s2 = Sheets("DURUŞMALAR")
s2.Select
s2.Range("A2:L1000").ClearComments
s1.Select
For i = 2 To s1.Range("A65536").End(3).Row
aa = s1.Cells(i, "AQ").Value
If aa <> "" Then
s2.Select
sonsat = s2.Range("A65536").End(3).Row + 1
s2.Cells(sonsat, "A").Value = s1.Cells(i, "AQ").Value
s2.Cells(sonsat, "B").Value = s1.Cells(i, "A").Value
s2.Cells(sonsat, "C").Value = s1.Cells(i, "B").Value
s2.Cells(sonsat, "D").Value = s1.Cells(i, "C").Value
s2.Cells(sonsat, "E").Value = s1.Cells(i, "D").Value
s2.Cells(sonsat, "F").Value = s1.Cells(i, "E").Value
s2.Cells(sonsat, "G").Value = s1.Cells(i, "F").Value
s2.Cells(sonsat, "H").Value = s1.Cells(i, "Q").Value
s2.Cells(sonsat, "I").Value = s1.Cells(i, "AR").Value
s2.Cells(sonsat, "J").Value = s1.Cells(i, "BW").Value
s2.Cells(sonsat, "K").Value = s1.Cells(i, "BX").Value
s2.Cells(sonsat, "L").Value = s1.Cells(i, "AP").Value
End If
Next
end if
Sheets("ANA SAYFA").select
End Sub
 
sayın hocam yalnız bir sonraki yılı tüm duruşmalarda göstermiyo
 
sayın hocam düzeltiyorum.hepsi için bugün ve bugünden sonraki yıllarıda kapsayabilirmi.acaba
 
ormann' Alıntı:
sayın hocam düzeltiyorum.hepsi için bugün ve bugünden sonraki yıllarıda kapsayabilirmi.acaba
Genişletmek için tıkla ...

Yukarıda hepsi olarak verdiğim tarih belirtilen butun hucreleri alır. AQ hücresi boş değilse aktar dediğimiz için orada bir tarih kıstası yok.
Ordada silme islemi ClearContents olarak değişecek onu atlamışım yine:( onu duzeltmeniz gerekecek.

Sadece o yılın istiyorsanız ay için yaptığım formulü kopyalayarak Format(Date,"mm") formulunu ve ustundede aynı ifade olan "mm" işlemini "YYYY" olarak değiştirmeniz yeterli.

iyi çalışmalar.
 
merhaba arkadaşlar,

program sadece 1 sayfada değil de , diğer tüm sayfalarda aranıp,sonuç bulunacak şekilde yapılabilir mi?Eğer varsa kodu?

Teşekürler,
 
Huseyinkis' Alıntı:
Merhaba Ekteki formulleri denermisiniz.


Kod: 
Sub Bugun()
Set s1 = Sheets("SUÇ KAYDI")
Set s2 = Sheets("DURUŞMALAR")
s2.Select
s2.Range("A2:L1000").ClearComments
s1.Select
For i = 2 To s1.Range("A65536").End(3).Row
aa = Format(s1.Cells(i, "AQ").Value, "dd.mm.yyyy")
bb = Format(Date, "dd.mm.yyyy")
If aa = bb Then
s2.Select
sonsat = s2.Range("A65536").End(3).Row + 1
s2.Cells(sonsat, "A").Value = s1.Cells(i, "AQ").Value
s2.Cells(sonsat, "B").Value = s1.Cells(i, "A").Value
s2.Cells(sonsat, "C").Value = s1.Cells(i, "B").Value
s2.Cells(sonsat, "D").Value = s1.Cells(i, "C").Value
s2.Cells(sonsat, "E").Value = s1.Cells(i, "D").Value
s2.Cells(sonsat, "F").Value = s1.Cells(i, "E").Value
s2.Cells(sonsat, "G").Value = s1.Cells(i, "F").Value
s2.Cells(sonsat, "H").Value = s1.Cells(i, "Q").Value
s2.Cells(sonsat, "I").Value = s1.Cells(i, "AR").Value
s2.Cells(sonsat, "J").Value = s1.Cells(i, "BW").Value
s2.Cells(sonsat, "K").Value = s1.Cells(i, "BX").Value
s2.Cells(sonsat, "L").Value = s1.Cells(i, "AP").Value
End If
Next
End Sub

Sub Yarın()
Set s1 = Sheets("SUÇ KAYDI")
Set s2 = Sheets("DURUŞMALAR")
s2.Select
s2.Range("A2:L1000").ClearComments
s1.Select
For i = 2 To s1.Range("A65536").End(3).Row
aa = Format(s1.Cells(i, "AQ").Value, "dd.mm.yyyy")
bb = Format(Date + 1, "dd.mm.yyyy")
If aa = bb Then
s2.Select
sonsat = s2.Range("A65536").End(3).Row + 1
s2.Cells(sonsat, "A").Value = s1.Cells(i, "AQ").Value
s2.Cells(sonsat, "B").Value = s1.Cells(i, "A").Value
s2.Cells(sonsat, "C").Value = s1.Cells(i, "B").Value
s2.Cells(sonsat, "D").Value = s1.Cells(i, "C").Value
s2.Cells(sonsat, "E").Value = s1.Cells(i, "D").Value
s2.Cells(sonsat, "F").Value = s1.Cells(i, "E").Value
s2.Cells(sonsat, "G").Value = s1.Cells(i, "F").Value
s2.Cells(sonsat, "H").Value = s1.Cells(i, "Q").Value
s2.Cells(sonsat, "I").Value = s1.Cells(i, "AR").Value
s2.Cells(sonsat, "J").Value = s1.Cells(i, "BW").Value
s2.Cells(sonsat, "K").Value = s1.Cells(i, "BX").Value
s2.Cells(sonsat, "L").Value = s1.Cells(i, "AP").Value
End If
Next
End Sub


Sub Hafta()
Set s1 = Sheets("SUÇ KAYDI")
Set s2 = Sheets("DURUŞMALAR")
s2.Select
s2.Range("A2:L1000").ClearComments
s1.Select
For i = 2 To s1.Range("A65536").End(3).Row
aa = Format(s1.Cells(i, "AQ").Value, "dd.mm.yyyy")
bb = Format(Date, "dd.mm.yyyy")
cc = Format(Date + 7, "dd.mm.yyyy")
If aa >= bb And aa <= cc Then
s2.Select
sonsat = s2.Range("A65536").End(3).Row + 1
s2.Cells(sonsat, "A").Value = s1.Cells(i, "AQ").Value
s2.Cells(sonsat, "B").Value = s1.Cells(i, "A").Value
s2.Cells(sonsat, "C").Value = s1.Cells(i, "B").Value
s2.Cells(sonsat, "D").Value = s1.Cells(i, "C").Value
s2.Cells(sonsat, "E").Value = s1.Cells(i, "D").Value
s2.Cells(sonsat, "F").Value = s1.Cells(i, "E").Value
s2.Cells(sonsat, "G").Value = s1.Cells(i, "F").Value
s2.Cells(sonsat, "H").Value = s1.Cells(i, "Q").Value
s2.Cells(sonsat, "I").Value = s1.Cells(i, "AR").Value
s2.Cells(sonsat, "J").Value = s1.Cells(i, "BW").Value
s2.Cells(sonsat, "K").Value = s1.Cells(i, "BX").Value
s2.Cells(sonsat, "L").Value = s1.Cells(i, "AP").Value
End If
Next
End Sub

Sub AY()
Set s1 = Sheets("SUÇ KAYDI")
Set s2 = Sheets("DURUŞMALAR")
s2.Select
s2.Range("A2:L1000").ClearComments
s1.Select
For i = 2 To s1.Range("A65536").End(3).Row
aa = Format(s1.Cells(i, "AQ").Value, "mm")
bb = Format(Date, "mm")
If aa = bb Then
s2.Select
sonsat = s2.Range("A65536").End(3).Row + 1
s2.Cells(sonsat, "A").Value = s1.Cells(i, "AQ").Value
s2.Cells(sonsat, "B").Value = s1.Cells(i, "A").Value
s2.Cells(sonsat, "C").Value = s1.Cells(i, "B").Value
s2.Cells(sonsat, "D").Value = s1.Cells(i, "C").Value
s2.Cells(sonsat, "E").Value = s1.Cells(i, "D").Value
s2.Cells(sonsat, "F").Value = s1.Cells(i, "E").Value
s2.Cells(sonsat, "G").Value = s1.Cells(i, "F").Value
s2.Cells(sonsat, "H").Value = s1.Cells(i, "Q").Value
s2.Cells(sonsat, "I").Value = s1.Cells(i, "AR").Value
s2.Cells(sonsat, "J").Value = s1.Cells(i, "BW").Value
s2.Cells(sonsat, "K").Value = s1.Cells(i, "BX").Value
s2.Cells(sonsat, "L").Value = s1.Cells(i, "AP").Value
End If
Next
End Sub
Genişletmek için tıkla ...






Sayın Hüseyin yukarıdaki daha önceden düzenlemiş olduğunuz makroları tarihe göre sıralama yapabilirmisiniz.Bir ara bakarız demiştiniz saygılar
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst