2 tarih arası listeleme

Katılım
15 Mart 2005
Mesajlar
11
verdiğim 2 tarih arası listeleme yapmasını istiyorum acaba yardımcı olabilirmisiniz ???
 
Katılım
4 Mart 2005
Mesajlar
68
Excel Vers. ve Dili
Excel 2003
Odemeler

Arkadasim Ekteki Gibi Bir Dosya Yaptim Insallah Isinize Yarar
 
Katılım
15 Mart 2005
Mesajlar
11
eline koluna sağlık fakat tarihleri de görmem gerekiyor... ayrıca bütün diğer yaptıklarımıda silmişsin ama benim onlara ihtiyacım var...
 
Son düzenleme:

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
eline koluna sağlık fakat tarihleri de görmem gerekiyor... ayrıca bütün diğer yaptıklarımıda silmişsin ama benim onlara ihtiyacım var...
Sayın arifcell'in kodlarına bir kaç ilave yaptım.
Ekli dosyayı inceleyiniz.:cool:
 
Katılım
15 Mart 2005
Mesajlar
11
benim konuyu açarken ilk eklediğim dosyaya sizin örneğinizi monte etmenizi istiyorum...
teşekkürler Evren Gizlen
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
benim konuyu açarken ilk eklediğim dosyaya sizin örneğinizi monte etmenizi istiyorum...
teşekkürler Evren Gizlen
Dosyanız hazır.:cool:
Kod:
Sub SORGU()
Dim ILKTARIH As Variant
Dim SONTARIH As Variant
Dim ODEMETRH As Variant
Dim Z As Integer

Z = 3
ILKTARIH = InputBox("ODEME BASLAMA TARIHINI YAZINIZ", "ODEME BASLAMA TARIHINI YAZINIZ", "01.01.2008")
SONTARIH = InputBox("ODEME BİTİŞ TARIHINI YAZINIZ", "ODEME BASLAMA TARIHINI YAZINIZ", "15.03.2009")
ILKTARIH = CDate(ILKTARIH)
SONTARIH = CDate(SONTARIH)
Application.ScreenUpdating = False
Range("P3:S65536").ClearContents
For X = 3 To Cells(65536, "B").End(xlUp).Row
ODEMETRH = Cells(X, 5).Value
    If (ODEMETRH >= ILKTARIH) And (ODEMETRH <= SONTARIH) Then
        Cells(Z, "P").Value = Cells(X, 5)
        Cells(Z, "Q").Value = Cells(X, 3)
        Cells(Z, "R").Value = Cells(X, 6)
        Cells(Z, "S").Value = Cells(X, 7).Value
        Z = Z + 1
    End If
Next X
Cells(Z, "Q").Value = "TOPLAM..:"
Cells(Z, "R").Formula = "=sum(R3:R" & Z - 1 & ")"
Cells(Z, "S").Formula = "=sum(S3:S" & Z - 1 & ")"
Application.ScreenUpdating = True
MsgBox "Sorgulama Yapıldı..!!", vbOKOnly + vbInformation, Application.UserName
End Sub
 
Son düzenleme:

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
çok teşekkürler Evren Gizlen süper olmuş
Hayır olmamış şimdi farkettim.
Toplama aralığını düzeltmeyi unutmuşum,yanlış yeri topluyor, onuda düzeltip dosyayı tekrardan ekleyecem.:cool:
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Toplama formülündeki hatayı düzelttim.
9 numaralı mesajdan dosyayı indirebilirsiniz.:cool:
 
Katılım
7 Temmuz 2004
Mesajlar
327
Excel Vers. ve Dili
office xp pro türkçe
Evren &#252;stad&#305;n kodlar&#305;n&#305;n d&#252;zenlenmi&#351; hali Te&#351;ekk&#252;rler &#252;stad

Kod:
Sub Makro1()

On Error Resume Next

Dim start As Date
Dim finish As Date


Dim ILKTARIH As Variant
Dim SONTARIH As Variant
Dim ODEMETRH As Variant
Dim Z As Integer


Z = 31
ILKTARIH = InputBox("ODEME BASLAMA TARIHINI YAZINIZ", "ODEME BASLAMA TARIHINI YAZINIZ", Format(Date, "dd.mm.yyyy")) '"01.01.2008")
1
SONTARIH = InputBox("ODEME B&#304;T&#304;&#350; TARIHINI YAZINIZ", "ODEME BASLAMA TARIHINI YAZINIZ", "15.03.2009")
ILKTARIH = CDate(ILKTARIH)
SONTARIH = CDate(SONTARIH)
If IsDate(SONTARIH) = False Then GoTo 1

'End If

start = Time

Debug.Print start

Application.ScreenUpdating = False
Range("H31:M65536").ClearContents

For X = 3 To Cells(65536, "B").End(xlUp).Row
ODEMETRH = Cells(X, 5).Value
    
    Debug.Print X
   '--------------------------ytl yazd&#305;r----------------------------
    If (ODEMETRH >= ILKTARIH) And (ODEMETRH <= SONTARIH) Then
        Cells(Z, 9).Value = Cells(X, 3) 'bayi ad&#305;
        Cells(Z, 10).Value = Cells(X, 6) '&#246;deme ytl
         Z = Z + 1
    End If
Next X
Cells(Z, "I").Value = "TOPLAM..:"
Cells(Z, "I").Font.Bold = True

Cells(Z, "J").Formula = "=sum(J31:J" & Z - 1 & ")"
Cells(Z, "J").Font.Bold = True


Cells(29, "I") = ILKTARIH & " ile " & SONTARIH
Cells(29, "L") = ILKTARIH & " ile " & SONTARIH

Z = 31
For X = 3 To Cells(65536, "B").End(xlUp).Row
ODEMETRH = Cells(X, 5).Value
    
    Debug.Print X
   '--------------------------dolar yazd&#305;r----------------------------
    If (ODEMETRH >= ILKTARIH) And (ODEMETRH <= SONTARIH) And Cells(X, 7) <> isnotNull Then
    
        Cells(Z, 12).Value = Cells(X, 3) 'bayi ad&#305;
               
        Cells(Z, 13).Value = Cells(X, 7).Value '&#246;deme $
        Z = Z + 1
    End If
Next X

Cells(Z, "L").Value = "TOPLAM..:"
Cells(Z, "L").Font.Bold = True

Cells(Z, "M").Formula = "=sum(M31:M" & Z - 1 & ")"
Cells(Z, "M").Font.Bold = True

Cells(29, "L") = ILKTARIH & " ile " & SONTARIH

Application.ScreenUpdating = True

finish = Time
Debug.Print finish


Call MsgBox(Format(finish - start, "hh:mm:nn") & "saniye de i&#351;lem tamamland&#305;", vbInformation)


End Sub
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Evren üstadın kodlarının düzenlenmiş hali Teşekkürler üstad

Kod:
Sub Makro1()

On Error Resume Next

Dim start As Date
Dim finish As Date


Dim ILKTARIH As Variant
Dim SONTARIH As Variant
Dim ODEMETRH As Variant
Dim Z As Integer


Z = 31
ILKTARIH = InputBox("ODEME BASLAMA TARIHINI YAZINIZ", "ODEME BASLAMA TARIHINI YAZINIZ", Format(Date, "dd.mm.yyyy")) '"01.01.2008")
1
SONTARIH = InputBox("ODEME BİTİŞ TARIHINI YAZINIZ", "ODEME BASLAMA TARIHINI YAZINIZ", "15.03.2009")
ILKTARIH = CDate(ILKTARIH)
SONTARIH = CDate(SONTARIH)
If IsDate(SONTARIH) = False Then GoTo 1

'End If

start = Time

Debug.Print start

Application.ScreenUpdating = False
Range("H31:M65536").ClearContents

For X = 3 To Cells(65536, "B").End(xlUp).Row
ODEMETRH = Cells(X, 5).Value
    
    Debug.Print X
   '--------------------------ytl yazdır----------------------------
    If (ODEMETRH >= ILKTARIH) And (ODEMETRH <= SONTARIH) Then
        Cells(Z, 9).Value = Cells(X, 3) 'bayi adı
        Cells(Z, 10).Value = Cells(X, 6) 'ödeme ytl
         Z = Z + 1
    End If
Next X
Cells(Z, "I").Value = "TOPLAM..:"
Cells(Z, "I").Font.Bold = True

Cells(Z, "J").Formula = "=sum(J31:J" & Z - 1 & ")"
Cells(Z, "J").Font.Bold = True


Cells(29, "I") = ILKTARIH & " ile " & SONTARIH
Cells(29, "L") = ILKTARIH & " ile " & SONTARIH

Z = 31
For X = 3 To Cells(65536, "B").End(xlUp).Row
ODEMETRH = Cells(X, 5).Value
    
    Debug.Print X
   '--------------------------dolar yazdır----------------------------
    If (ODEMETRH >= ILKTARIH) And (ODEMETRH <= SONTARIH) And Cells(X, 7) <> isnotNull Then
    
        Cells(Z, 12).Value = Cells(X, 3) 'bayi adı
               
        Cells(Z, 13).Value = Cells(X, 7).Value 'ödeme $
        Z = Z + 1
    End If
Next X

Cells(Z, "L").Value = "TOPLAM..:"
Cells(Z, "L").Font.Bold = True

Cells(Z, "M").Formula = "=sum(M31:M" & Z - 1 & ")"
Cells(Z, "M").Font.Bold = True

Cells(29, "L") = ILKTARIH & " ile " & SONTARIH

Application.ScreenUpdating = True

finish = Time
Debug.Print finish


Call MsgBox(Format(finish - start, "hh:mm:nn") & "saniye de işlem tamamlandı", vbInformation)


End Sub
Sayın abdi kodları ben yazmadım.Sayın arifcell yazmış.Ben sadece birkaç ilave yaptım ve bir iki değişiklik yaptım.
İyi çalışmalar.:cool:
 
Katılım
15 Mart 2005
Mesajlar
11
ufak bir soru daha var... acaba boş tutarları almasını nasıl engellerim ?

mesela dolar hanesini yada ytl hanesini boş bıraktığım firmalarıda yarın yapılacak ödemelerde ve tarihe göre sıralamada görebiliyorum acaba bunu nasıl süzebilirim ???
 
Katılım
7 Temmuz 2004
Mesajlar
327
Excel Vers. ve Dili
office xp pro türkçe
Bu arada arifcell ve Evren &#252;stada te&#351;ekk&#252;rler
onlar&#305;n yazd&#305;klar&#305; kodlar&#305; biraz revize edince dosya sizin istedi&#287;iniz hale geldi

Benim d&#252;zenledi&#287;im kodlar zaten bunu yap&#305;yor
dosyan&#305;za uyarlanm&#305;&#351; hali ekte
 
Katılım
4 Mart 2005
Mesajlar
68
Excel Vers. ve Dili
Excel 2003
Arkada&#351;lar ilginize te&#351;ekk&#252;r ederim.Say&#305;n Muratboy312in i&#351;i g&#246;r&#252;ls&#252;n diye acele ile ufak bi &#231;al&#305;&#351;ma yapt&#305;m.Siz degerli dostlar&#305;m tamamen i&#351;i halletmi&#351;siniz.Hepinize Te&#351;ekk&#252;r ederim.
 
Üst