Veriyi 10 günlük olarak ayırma

[emiroglu07]

İndir Desktop

Dosyayı indir Desktop

dosya.co

Üstadlar merhaba bir konuda yardımınıza sığınıyorum elimdeki excel yevmiye kaydını tarih sırasına göre dizip
*csv formatında Onar günlük hayde ayrı excel dosyaları kopyalamak istiyorum.
gün bazın 01 - 10 / 11- 20 / 21 - 30 / 31 olarak (4 ayrı farklı excel dosyası olarak kopyalamak istiyorum)
bu konu hakkında yardımcı olabilirmisiniz şimdiden teşekkür ederim.

 

[Korhan Ayhan]

Deneyiniz.

CSV dosyaları makroyu uyguladığınız dosyanızın bulunduğu klasörde oluşturulacaktır.

Option Explicit

Sub Tarihe_Gore_Sirala_CSV_Biciminde_Dosyalara_Aktar()
    Dim File_Path As String, X As Date, Say As Byte
    Dim Min_Date As Date, Max_Date As Date
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    File_Path = ThisWorkbook.Path
    
    Range("A2:I" & Rows.Count).Sort Range("B2"), xlAscending

    Min_Date = WorksheetFunction.Min(Range("B:B"))
    Max_Date = WorksheetFunction.Max(Range("B:B"))

    For X = Min_Date To Max_Date Step 10
        Range("A1:I" & Rows.Count).AutoFilter 2, ">=" & CLng(CDate(X)), xlAnd, "<=" & CLng(CDate(X + 9))
        If Cells(Rows.Count, 2).End(2).Row > 1 Then
            Range("A1:I" & Cells(Rows.Count, 2).End(3).Row).Copy
            Workbooks.Add (1)
            Range("A1").PasteSpecial
            Range("A1").Select
            Columns.AutoFit
            Say = Say + 1
            ActiveWorkbook.SaveAs File_Path & "\" & Say & "_egitim_matrahin_icinde_8-18.csv", xlCSV
            ActiveWorkbook.Close 0
        End If
    Next
    
    On Error Resume Next
    ActiveSheet.ShowAllData
    On Error GoTo 0
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    MsgBox "Veriler CSV formatında " & Say & " adet dosyaya aktarılmıştır.", vbInformation
End Sub

 

[emiroglu07]

İndir AKTARMA HATA

Dosyayı indir AKTARMA HATA

dosya.co

Üstad zaman ayırıp ilgilendiğin için teşekkür ederim yapılan işlem kesinlikle doğru yanlız csv formatını düzmetin olarak aktarmaktadır vermiş olduğum ekli dosyada hem dosyanın formatını hem de günlere gore ayrılan excel dosyasını formatını nasıl olması gerektiğini ekledim yardımınız için çok müteşekkirim .

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Tarihe_Gore_Sirala_CSV_Biciminde_Dosyalara_Aktar()
    Dim File_Path As String, X As Date, Say As Byte
    Dim Min_Date As Date, Max_Date As Date
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    File_Path = ThisWorkbook.Path
    
    Range("A2:I" & Rows.Count).Sort Range("B2"), xlAscending

    Min_Date = WorksheetFunction.Min(Range("B:B"))
    Max_Date = WorksheetFunction.Max(Range("B:B"))

    For X = Min_Date To Max_Date Step 10
        Range("A1:I" & Rows.Count).AutoFilter 2, ">=" & CLng(CDate(X)), xlAnd, "<=" & CLng(CDate(X + 9))
        If Cells(Rows.Count, 2).End(2).Row > 1 Then
            Range("A1:I" & Cells(Rows.Count, 2).End(3).Row).Copy
            Workbooks.Add (1)
            Range("A1").PasteSpecial
            Range("A1").Select
            Columns.AutoFit
            Say = Say + 1
            ActiveWorkbook.SaveAs File_Path & "\" & Say & "_egitim_matrahin_icinde_8-18.csv", FileFormat:=xlCSV, Local:=True
            ActiveWorkbook.Close 0
        End If
    Next
    
    On Error Resume Next
    ActiveSheet.ShowAllData
    On Error GoTo 0
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    MsgBox "Veriler CSV formatında " & Say & " adet dosyaya aktarılmıştır.", vbInformation
End Sub

 

[ziya]

Merhaba,

Yukarıdaki makroyu dosyama uyguladım 3 yere yapılacak değişikliğe ihtiyacam var.
1- Benim sütunlarım "O" sütununa kadar. Kodlarda iki yerde " A1:I " ve bir yerde " A2:I " var. " A1:I " ları " A1:O " yaptım, sorun olmadı , " A2:I " i " A2:O " yaptım hata verdi.

 Range("A2:I" & Rows.Count).Sort Range("B2"), xlAscending

2- Tarih gün sayısı 10 dan küçük olduğunda, tarih gün formatı tek basamaklı geliyor, 2 basamaklı olmalı. 5 değil de 05 gibi. Şöyle bir kod uyguladım sonuç vermedi.

Columns("B:B").Select
    Selection.Replace What:="-", Replacement:=".", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.NumberFormat = "dd/mm/yyyy;@"

3- Dosya adı.
Dosya Adı "GELENNA_2022_01_... .csv" 2022 ve 01 yıl ve ay, dolayısiyle değişken. Onu şu formülle çözmeye çalıştım, olmadı.

_GELENNA- ""&YEAR(TODAY())&""-0""&MONTH(TODAY())-"&"Say"

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

 

[ziya]

Merhaba,

Yukarıdaki makroyu dosyama uyguladım 3 yere yapılacak değişikliğe ihtiyacam var.
1- Benim sütunlarım "O" sütununa kadar. Kodlarda iki yerde " A1:I " ve bir yerde " A2:I " var. " A1:I " ları " A1:O " yaptım, sorun olmadı , " A2:I " i " A2:O " yaptım hata verdi.

 Range("A2:I" & Rows.Count).Sort Range("B2"), xlAscending

2- Tarih gün sayısı 10 dan küçük olduğunda, tarih gün formatı tek basamaklı geliyor, 2 basamaklı olmalı. 5 değil de 05 gibi. Şöyle bir kod uyguladım sonuç vermedi.

Columns("B:B").Select
    Selection.Replace What:="-", Replacement:=".", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.NumberFormat = "dd/mm/yyyy;@"

3- Dosya adı.
Dosya Adı "GELENNA_2022_01_... .csv" 2022 ve 01 yıl ve ay, dolayısiyle değişken. Onu şu formülle çözmeye çalıştım, olmadı.

_GELENNA- ""&YEAR(TODAY())&""-0""&MONTH(TODAY())-"&"Say"

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

1 nci ve 3 ncü madde önemli değil.
2.nci maddeye çözüm bulunabilir mi. Ay'ın ilk 9 günü 1, 2 , 3 g,b, değil de , 01, 02, 03 formatında olabilir mi.

 

[Korhan Ayhan]

Merhaba,

1- Hata veren kod satırı sıralama işlemi yapmaktadır. Bu sebeple hata vermesi bana biraz garip geldi.

2- Eğer hücrelerde ki verileriniz gerçekten tarihse hücre biçimlendirme (gg.aaaa.yyy) ile yapabilirsiniz.

3- Verileri birleştirirken çift tırnak işaretlerini uygun şekilde yazmalısınız.

"GELENNA_" & Format(Date, "yyyy_mm") & Say & ".csv"

 

[ziya]

Merhaba,

1- Hata veren kod satırı sıralama işlemi yapmaktadır. Bu sebeple hata vermesi bana biraz garip geldi.

2- Eğer hücrelerde ki verileriniz gerçekten tarihse hücre biçimlendirme (gg.aaaa.yyy) ile yapabilirsiniz.

3- Verileri birleştirirken çift tırnak işaretlerini uygun şekilde yazmalısınız.

"GELENNA_" & Format(Date, "yyyy_mm") & Say & ".csv"

Korhan hocam,
Hem uyarınzı tam olarak anladım, zaten doğrusunu yazmışsınız, bana uygulamak kalmış ve uyguladım. Dört dörtlük oldu.

Teşekkür ederim.