DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub Aktar()
Dim i As Long, _
j As Long, _
Yil As Integer, _
Ay As Integer, _
ShV As Worksheet, _
ShS As Worksheet, _
BTar As Date, _
STar As Date, _
Aylar
Application.ScreenUpdating = False
Set ShV = Sheets("Veri")
Set ShS = Sheets("Sayfa2")
Aylar = Array("Ocak", "Şubat", "Mart", "Nisan", "Mayıs", "Haziran", "Temmuz", "Ağustos", "Eylül", "Ekim", "Kasım", "Aralık")
Ay = Application.Match(ShS.Range("I5"), Application.Transpose(Aylar), 0)
Yil = ShS.Range("I4")
BTar = DateSerial(Yil, Ay, 14)
STar = DateSerial(Yil, Ay + 1, 15)
j = ShS.Cells(Rows.Count, "C").End(3).Row
If j < 9 Then j = 9
ShS.Range("C9:I" & j).ClearContents
j = 8
For i = 6 To ShV.Cells(Rows.Count, "C").End(3).Row
If Not ShV.Cells(i, "H") = "" Then
If ShV.Cells(i, "H") > BTar And ShV.Cells(i, "H") < STar Then
j = j + 1
ShV.Range(ShV.Cells(i, "C"), ShV.Cells(i, "I")).Copy ShS.Cells(j, "C")
End If
End If
Next i
Application.ScreenUpdating = True
If j - 8 = 0 Then
MsgBox "Şartı sağlayan veriye rastlanmadı", vbCritical, "Excel.web.tr"
Else
MsgBox j - 8 & " Adet Kayıt Listelenmiştir...", vbInformation, "Excel.web.tr"
End If
End Sub
Merhaba,
Makro ile çözüm isterseniz eğer; aşağıdaki kodları bir modüle kopyalayıp deneyiniz.
Kod:Sub Aktar() Dim i As Long, _ j As Long, _ Yil As Integer, _ Ay As Integer, _ ShV As Worksheet, _ ShS As Worksheet, _ BTar As Date, _ STar As Date, _ Aylar Application.ScreenUpdating = False Set ShV = Sheets("Veri") Set ShS = Sheets("Sayfa2") Aylar = Array("Ocak", "Şubat", "Mart", "Nisan", "Mayıs", "Haziran", "Temmuz", "Ağustos", "Eylül", "Ekim", "Kasım", "Aralık") Ay = Application.Match(ShS.Range("I5"), Application.Transpose(Aylar), 0) Yil = ShS.Range("I4") BTar = DateSerial(Yil, Ay, 14) STar = DateSerial(Yil, Ay + 1, 15) j = ShS.Cells(Rows.Count, "C").End(3).Row If j < 9 Then j = 9 ShS.Range("C9:I" & j).ClearContents j = 8 For i = 6 To ShV.Cells(Rows.Count, "C").End(3).Row If Not ShV.Cells(i, "H") = "" Then If ShV.Cells(i, "H") > BTar And ShV.Cells(i, "H") < STar Then j = j + 1 ShV.Range(ShV.Cells(i, "C"), ShV.Cells(i, "I")).Copy ShS.Cells(j, "C") End If End If Next i Application.ScreenUpdating = True If j - 8 = 0 Then MsgBox "Şartı sağlayan veriye rastlanmadı", vbCritical, "Excel.web.tr" Else MsgBox j - 8 & " Adet Kayıt Listelenmiştir...", vbInformation, "Excel.web.tr" End If End Sub
Merhaba,
Makro ile çözüm isterseniz eğer; aşağıdaki kodları bir modüle kopyalayıp deneyiniz.
Kod:Sub Aktar() Dim i As Long, _ j As Long, _ Yil As Integer, _ Ay As Integer, _ ShV As Worksheet, _ ShS As Worksheet, _ BTar As Date, _ STar As Date, _ Aylar Application.ScreenUpdating = False Set ShV = Sheets("Veri") Set ShS = Sheets("Sayfa2") Aylar = Array("Ocak", "Şubat", "Mart", "Nisan", "Mayıs", "Haziran", "Temmuz", "Ağustos", "Eylül", "Ekim", "Kasım", "Aralık") Ay = Application.Match(ShS.Range("I5"), Application.Transpose(Aylar), 0) Yil = ShS.Range("I4") BTar = DateSerial(Yil, Ay, 14) STar = DateSerial(Yil, Ay + 1, 15) j = ShS.Cells(Rows.Count, "C").End(3).Row If j < 9 Then j = 9 ShS.Range("C9:I" & j).ClearContents j = 8 For i = 6 To ShV.Cells(Rows.Count, "C").End(3).Row If Not ShV.Cells(i, "H") = "" Then If ShV.Cells(i, "H") > BTar And ShV.Cells(i, "H") < STar Then j = j + 1 ShV.Range(ShV.Cells(i, "C"), ShV.Cells(i, "I")).Copy ShS.Cells(j, "C") End If End If Next i Application.ScreenUpdating = True If j - 8 = 0 Then MsgBox "Şartı sağlayan veriye rastlanmadı", vbCritical, "Excel.web.tr" Else MsgBox j - 8 & " Adet Kayıt Listelenmiştir...", vbInformation, "Excel.web.tr" End If End Sub
Üstadım sanırım makroda sorun var. çünkü mesela mayıs ayını sorguladığımda 3 kayıt geliyor. ilgili aya 2012 mayıs yazdığımızda giriş tarihi mayıs ayından önce olup da çıkışı olmayan kişilerin hepsi, çıkış varsa da 15 mayıs-14 haziran tarihleri arasında ise yine buraya aktarması gerekli.
Evet hocam harflere dikkat ettim.Kodları kontrol ederek gönderdim. Ay adlarını yazarken Baş harflerini büyük yazmalısınız. Makro büyük küçük harf duyarlı değil.
Ona dikkat ettiniz mi?
Evet hocam harflere dikkat ettim.
mesela mayıs yazdığımda 3 tane kayıt geliyor ama ocak şubat mart ve nisan aylarında da griş var onları da getirmesi gerekirken getirmiyor.
Üstadım ben dosyayı tekrar yükledim. Orada açıklamayı biraz daha ayrıntılı yapmaya çalıştım. rica etsem kontrol edebilirmisiniz.Siz aynı dosyadan mı sözediyorsunuz?
Ben sadece çıkış tarihlerini kontrol ettim.
Kontrolü çıkış tarihine göre yapmıştım, ilk sorunuzdan öyle anlamıştım. Şimdi giriş tarihine göre diyorsunuz.
E bunu da düzeltmek kolay, kodlardaki çıkış tarihlerini giriş tarihine çevireceksiniz. H sütunu değil G sütununu dikkate alacaksınız.
Tabi yine yanlış anlamadıysam. Bunu da yaparsınız herhalde.
Üstadım aslında ilk soruda giriş tarihinden bahsetmemin sebebi zaten o kayıtların listelelenecek olmasıdır. çünkü ocak ayında giriş yapılan bir kişi zaten çıkış verilmediği sürece sürekli listeleneceksöylediğinizi yaptım ama olmadı..
Arkadaşlar ekteki örnekte de belirttim. kişilerin çıkış tarihlerine listeletmeye çalışıyorum. Aslında sadece çıkış tarihleri kısmına göre listeleme yapıyorum fakat işin içine tarihler girince tıkandım kaldım. yardımlarınızı rica ediyorum.
ARKADAŞLAR VERİ SAYFASINDAKİ VERİLERİ ı5 HÜCRESİNDEKİ AYA GÖRE BU LİSTEYE GETİRMEK İSTİYORUM.BURDA EN ÖNEMLİ KRİTER ÇIKIŞ TARİHİ.VERİ SAYFASINDA ÇIKIŞ TARİHİ DOLU OLAN KİŞİLERİN BURAYA AKTARILMASINI İSTEMİYORUM. AŞAĞIDA İLGİLİ AYA AİT DÖENMLERİ BELİRTTİM. MESELA KİŞİNİN ÇIKIŞ TARİHİ 10 NİSAN İSE BU KİŞİ 15 MART-14 NİSAN DÖNEMİNE YANİ MART DÖNEMİ İÇİNE GİRİYOR BU KİŞİYİ MART AYINA KADAR LİSTEYE ALABİLİRİZ FAKAT NİSAN DÖNEMİNE ALAMAYIZ.
.