iki tarih arası sıralama makrosu

[ahmetozbey]

sorum ekdedir ilgilenirseniz memnun olurum

 

[ahmetozbey]

yardımcı olursanız sevinirim

 

[Orion1]

Dosyanız ekte.

Sub liste()
Dim hcr As Range, sat As Long
Sheets("Sayfa1").Select
sat = 6
Application.ScreenUpdating = False
Range("H6:M65536").ClearContents
For Each hcr In Range("A7:A" & Cells(65536, "A").End(xlUp).Row)
    If hcr.Value >= Range("G3").Value And _
    hcr.Value <= Range("H3").Value Then
        For k = 0 To 5
            Cells(sat, k + 8).Value = hcr.Offset(0, k).Value
        Next k
        sat = sat + 1
    End If
Next
Range("H6:M65536").Sort Range("H6")
Application.ScreenUpdating = True
MsgBox "İşlem Tamam"
End Sub

 

[ahmetozbey]

kodlarda sanırım hata var.

 

[Orion1]

kodlarda sanırım hata var.

Nerede hata var?
Kodlar bende gayet güzel çalıştı.
Nerede hata varsa yazarsanız bizde bilelim.

 

[ahmetozbey]

girilen iki tarih arasındaki veriler geliyor ama gün ay yıl sırasına göre sıralanmasını istiyorum. (herhalde belirtmeyi unuttum)
dosya ekdedir.
şimdiden teşekkür ederim.

 

[Orion1]

girilen iki tarih arasındaki veriler geliyor ama gün ay yıl sırasına göre sıralanmasını istiyorum. (herhalde belirtmeyi unuttum)
dosya ekdedir.
şimdiden teşekkür ederim.

Gerekli düzenlemeyi yaptım.
3 numaralı mesajdan dosyayı indirebilirisniz.

 

[tahsinanarat]

sn. Evren Gizlen aynı sayfaya değilde, sayfa ikiye aktarmak isteseydik, kodlarda nasıl bir değişiklik olurdu, başka bir deşiyle sayfa2 içinde yaparmısınız. Şimdiden Teşekkürler.

 

[Korhan Ayhan]

Selamlar,

2. sayfaya aktarmak için aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub İKİ_TARİH_ARASI_SIRALI_LİSTELE()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim Satır As Long, Veri As Range
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
    S2.Select
    Satır = 1
    Application.ScreenUpdating = False
    S2.[A:F].ClearContents
        For Each Veri In S1.Range("A7:A" & S1.[A65536].End(xlUp).Row)
            If Veri.Value >= S1.[G3] And Veri.Value <= S1.[H3] Then
            S2.Range("A" & Sat&#305;r & ":F" & Sat&#305;r).Value = S1.Range("A" & Veri.Row & ":F" & Veri.Row).Value
            Sat&#305;r = Sat&#305;r + 1
            End If
        Next
    Range("A:F").EntireColumn.AutoFit
    Range("A:F").Sort Range("A1")
    Set S1 = Nothing
    Set S2 = Nothing
    Application.ScreenUpdating = True
    MsgBox "&#304;&#351;leminiz tamamlanm&#305;&#351;t&#305;r.", vbInformation
End Sub

 

[tahsinanarat]

sn. korhan hocam çok teşekkür ediyorum, bir soru daha sormak istiyorum, eğer tarih sutunu a sutunu değil de d sutununda olsaydı, diye deniyorum ancak saadece d tunundaki tarihleri aktarıyor, diğer sutunlar gelmiyor. kodda nasıl bir düzenleme olmalı. Yani tarih sutunu d sutunu olmuş olsaydı.

 

[tahsinanarat]

hocam tamam gerek kalmadı, şimdi oldu.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki koddaki kırmızı renkli bölümleri D olarak değiştirmeniz yeterli olacaktır.

For Each Veri In S1.Range("[COLOR=red]A[/COLOR]7:[COLOR=red]A[/COLOR]" & S1.[[COLOR=black]A[/COLOR]65536].End(xlUp).Row)

 

[tahsinanarat]

Teşekkür ederim Korhan hocam, benim yapamadığım Evren hocamın örneğindeki kodlarda imiş, orada bahsettiğiniz şekilde tarih sutununu değiştirerek denememe rağmen tarih sutunundaki önceki ve sonraki sutunlar (satırdaki diğer bilgiler) gelmiyor. Daha doğrusu getiremedim. Saygılar,

 

[Orion1]

Teşekkür ederim Korhan hocam, benim yapamadığım Evren hocamın örneğindeki kodlarda imiş, orada bahsettiğiniz şekilde tarih sutununu değiştirerek denememe rağmen tarih sutunundaki önceki ve sonraki sutunlar (satırdaki diğer bilgiler) gelmiyor. Daha doğrusu getiremedim. Saygılar,

Gelir gelir.
Aşağıdaki kırmızı ile yazılmış yerleri tarihi lerin bulunduğu sütun adınını yazınız.
For Each hcr In Range("A7:A" & Cells(65536, "A").End(xlUp).Row)

 

[tahsinanarat]

Sn. Evren hocam denedim, saadece tarih bulunan sutun ve sonrasını alıyor, önceki kolonlardaki bilgiler gelmiyor. yukarıda bunu izah etmeye çalışmıştım. Saygılarımla.

 

[Orion1]

soldaki bir sütun öncesi için aşağıdaki gibi uygulayınız.

For k = [B][COLOR="Red"]-1[/COLOR][/B] To 5
            Cells(sat, k + 8).Value = hcr.Offset(0, k).Value
Next k

 

[tahsinanarat]

tarih sunutunda önceki sutunları alabilmek için kaç sutun öncesi alınacak ise (örneğimizde d sutununda tarih olduğunu varsayarsak)
For k = -3 To 5
Cells(sat, k + 11).Value = hcr.Offset(0, k).Value
Next k
şeklinde olacağı anlaşılmıştır.
İlgi ve alakanıza çok çok teşekkür ediriz, her soru cevapda birşeyler öğreniyoruz. Tekrar teşekkür ederim.