• DİKKAT

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

Çalışma sayfasını 400 satır halinde CSV yapmak

Katılım
22 Ekim 2012
Mesajlar
311
Excel Vers. ve Dili
Office 2016 Türkçe
Merhaba,

Ekte bulunan excel dosyası bazen 8 bin 10 bin satır olabiliyor.
Bunu 400'er satır halinde CSV ye dönüştürerek kayıt edebiliyordum.

Ancak yeni iki sütun ekledim bu defa sadece 1 adet 400 satırlık bir CSV kayıt yapabiliyor. Bütün dikkatime rağmen düzeltemedim.

Yardımcı olabilecek arkadaşlara şimdiden teşekkür ediyorum.
 

Ekli dosyalar

Merhaba.

Sayfa_Aktar makrosunda, CSV oluşturma makrosuna atıf yaparken ilgili makronun adını yanlış yazmışsınız veya
Csv oluşturma makrosunun adını sonradan değiştirmişsiniz.

Sayfa_Aktar makrosunda iki yerde bulunan, Excel_Dosyasini_Csv_Yap satırlarını
Dosyayı_Csv_Yap olarak değiştirmeniz yeterli olur.
.
 
Merhaba Ömer Bey,

Dediğinizi yaptım ama olmadı. Sadece 1 adet 400 satırlık csv dosyası kayıt yapıyor.

Dosyada başka makro da var onlar önemli değil sadece CSV KAYIT klasörün içinde 400 er satırlık csv dosyası oluşturmak.

Saygılar,
 
Tekrar merhaba.

Ben önceki cevabımı verirken sayfadaki düğmeyi kullanmayıp, doğrudan VBA ekranındaki makroyu çalıştırarak denemiştim.

Sayfadaki düğmeyle ilişkilendirilecek makro; Dosyayı_Csv_Yap değil,
önceki cevabımda belirttiğim değişikliği yaptıktan sonra, Sayfa_Aktar makrosu olmalıdır.

Böyle yaparsanız başlık hariç 399 satırlık CSV dosyalar sorunsuzca oluşturuluyor.
.
 
Ömer Bey Merhaba,

Acemilik bu olsa gerek ben hep csv dosyası yap makrosuna dikkat çektiğimden diğer farklılıkları göremedim. Dediğiniz gibi sorunu sayenizde çözdüm.

Çok çok teşekkür ederim, elinize bilginize sağlık.

Hoşçakalın
 
Ömer bey, csv kayıtta tarih kısmını; 1.01.2018 olarak alıyor.
Oysa 01.01.2018 olması gerekir.

Ben bunu çözümünü manuel olarak tarih formatından düzeltiyorum ve kaydediyorum.
Tekrar açtığımda yine eskisi gibi oluyor.

Teşekkür eder saygılar sunarım.
 
Kod:
Print #1, Format(Range("A" & i),"dd.mm.yyyy") & ";" & Range("B" & i) & ";" & Range("C" & i) & _
                   ";" & Range("D" & i) & ";" & Range("E" & i) & ";" & Range("F" & i) & ";" & Range("G" & i) & _
                    ";" & Range("H" & i) & ";" & Range("I" & i) & ";" & Range("j" & i) & ";" & Range("k" & i)
olarak deneyin.
 
Merhaba Askm,

İlginize teşekkür ederim. Verdiğiniz kodu denetim yine tarih formatını 1.01.2018 olarak verdi.
Ana Menü dediğimiz dosya sayfasında Csv diye bir sayfa daha var. Bu sayfa olmasa da olur. Bunu silebilirsiniz. Bu dosyayı bu forumdan aldım. Kendime göre uyarlamaya çalıştım.

Tekrar ilginize teşekkür ederim.
 
Oluşanm CVS dosya ektedir. Belirttiğiniz kodlara bakmadım zaten sadece Dosyayı_Csv_Yap koduna baktım. Ve 01.01.2018 şeklinde geldi.
Bir de aşağıdaki şekilde deneyin.
Kod:
Sub Dosyayı_Csv_Yap()
Dim i As Long
Dim dosya, bak
Application.DisplayAlerts = False
Set dosya = CreateObject("Scripting.FileSystemObject")
 

    bak = dosya.FolderExists(ThisWorkbook.Path & "\" & "CSV KAYIT")
    If bak <> True Then
        dosya.CreateFolder ThisWorkbook.Path & "\" & "CSV KAYIT"
    End If

    Dim dosyam As String
    Dim Ert As Long, son_satır As Long, kayit As Long
    son_satır = Range("A65000").End(3).Row
    dosyam = ThisWorkbook.Path & "\CSV KAYIT\KAYIT - " & kaydim & ".csv"
    
    Open dosyam For Output As #1
    For i = 1 To 400
       Print #1, Range("A" & i).Text & ";" & Range("B" & i).Text & ";" & Range("C" & i).Text & _
                   ";" & Range("D" & i).Text & ";" & Range("E" & i).Text & ";" & Range("F" & i).Text & ";" & Range("G" & i).Text & _
                    ";" & Range("H" & i).Text & ";" & Range("I" & i).Text & ";" & Range("j" & i).Text & ";" & Range("k" & i).Text
    Next
    Close #1
End Sub
 

Ekli dosyalar

Sayın Askm,

Dediğiniz gibi değişiklik yaptım maalesef tarih formatı aynı. Eklediğiniz dosya da tarih formatı 1.01.2018 olarak gözükmektedir.

Değişiklik yaptığım dosya da ektedir.

Tekrar teşekkür çok ederim
 

Ekli dosyalar

Deneyiniz.

Kod:
Dim kaydim As Integer

Sub Sayfa_Aktar()
    Dim s1, s2 As Worksheet, Satir As Long, X As Long
    Set s1 = Worksheets("Dosya Aktar")
    Set s2 = Worksheets("csv")
    Application.ScreenUpdating = False
    kaydim = 0
    s2.Select
    
    With s2
        .Range("A2:K65000").ClearContents
        
        Satir = s2.Cells(65000, 1).End(3).Row + 1
        
        .Cells(1, 1) = "Fatura_Tarihi"
        .Cells(1, 2) = "Fatura_No"
        .Cells(1, 3) = "Müşteri_Ünvanı"
        .Cells(1, 4) = "Fat_Toplamı"
        .Cells(1, 5) = "Matrah_00"
        .Cells(1, 6) = "KDV_Dahil_01"
        .Cells(1, 7) = "KDV_01"
        .Cells(1, 8) = "KDV_Dahil_08"
        .Cells(1, 9) = "KDV_08"
        .Cells(1, 10) = "KDV_Dahil_18"
        .Cells(1, 11) = "KDV_18"
        
        For X = 2 To s1.Range("A65000").End(3).Row
            .Cells(Satir, 1).Value = s1.Cells(X, "A").Value
            .Cells(Satir, 2).Value = s1.Cells(X, "B").Value
            .Cells(Satir, 3).Value = s1.Cells(X, "C").Value
            .Cells(Satir, 4).Value = s1.Cells(X, "D").Value
            .Cells(Satir, 5).Value = s1.Cells(X, "E").Value
            .Cells(Satir, 6).Value = s1.Cells(X, "F").Value
            .Cells(Satir, 7).Value = s1.Cells(X, "G").Value
            .Cells(Satir, 8).Value = s1.Cells(X, "H").Value
            .Cells(Satir, 9).Value = s1.Cells(X, "I").Value
            .Cells(Satir, 10).Value = s1.Cells(X, "j").Value
            .Cells(Satir, 11).Value = s1.Cells(X, "K").Value
            
            If Satir = 100 Then
                Satir = 2
                kaydim = kaydim + 1
                .Range("A2:A100").NumberFormat = "dd/mm/yyyy;@"
                Dosyayı_Csv_Yap
                .Range("A2:K100").ClearContents
            Else
                Satir = Satir + 1
            End If
        Next
    End With
    
    kaydim = kaydim + 1
    Dosyayı_Csv_Yap
    
    Application.ScreenUpdating = True
    s1.Select
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Sub Dosyayı_Csv_Yap()
    Dim i As Long
    Dim dosya, bak
    Application.DisplayAlerts = False
    Set dosya = CreateObject("Scripting.FileSystemObject")
    
    bak = dosya.FolderExists(ThisWorkbook.Path & "\" & "CSV KAYIT")
    If bak <> True Then
    dosya.CreateFolder ThisWorkbook.Path & "\" & "CSV KAYIT"
    End If
    
    Dim dosyam As String
    Dim Ert As Long, son_satır As Long, kayit As Long
    son_satır = Range("A65000").End(3).Row
    dosyam = ThisWorkbook.Path & "\CSV KAYIT\KAYIT - " & kaydim & ".csv"
    
    Open dosyam For Output As #1
    For i = 1 To 400
        Print #1, Range("A" & i).Text & ";" & Range("B" & i).Text & ";" & Range("C" & i).Text & _
        ";" & Range("D" & i).Text & ";" & Range("E" & i).Text & ";" & Range("F" & i).Text & ";" & Range("G" & i).Text & _
        ";" & Range("H" & i).Text & ";" & Range("I" & i).Text & ";" & Range("j" & i).Text & ";" & Range("k" & i).Text
    Next
    Close #1
End Sub
 
Korhan Bey Merhaba,

Öncelikle ilginiz için çok teşekkür ederim.

Bendeki tüm makroyu sildim. Sadece sizin yazdığınız kodları yazarak "Sayfa Aktar" makrosunu çalıştırdım. Oluşturduğu CSV dosyaları ayın 10'una kadar 1.01.2018 olarak oluşturuyor. Sonrasında ise sorun yok. Örn: 15.01.2018 olarak doğru kayıt yapıyor.

Bunu muhasebeye aktarmak için kullanıyorum tarih eğer 1.01.2018 gibi geliyorsa hata veriyor. Aktarım yapmıyor. CSV dosyasında manuel olarak tarihi düzeltiyorum. Ama kayıt yapıp tekrar dosyayı açınca tarih formatı yine bozuluyor.

Saygı ve hürmetle
 
Tarih olan hücredeki karakter uzunluğunu saldırıp başına 0 ekleyebilirsiniz. Eğer 10 karakterden az ise tarihin başına sıfır ekleyin.
 
Sayın Askm Merhaba,

Evet zaten çözümü öyle buldum. Ancak CSV olarak kayt edip tekrar açtığımda yine tarih formatı 1.01.2018 olarak gözüküyor.
 
Başka bilgisayarda deneme imkanınız var mı. Çünkü bende offıce 2010 32 bit var ve normal gözüküyor.
 
Sayın Askm Merhaba,

Evet zaten çözümü öyle buldum. Ancak CSV olarak kayt edip tekrar açtığımda yine tarih formatı 1.01.2018 olarak gözüküyor.

Merhaba. Problem işletim sisteminde. İşletim sisteminin tarih ayarını (biçimini) değiştirin. İstediğiniz düzene gelecektir. (Aynı problemi ben de yaşadım)
 
Merhaba Zeki Bey,

Çok teşekkür ederim tam dediğiniz gibiydi. Sistem tarih formatını gg.aa.yyyy
olarak düzelttim sorun çözüldü.

Size ve emeği geçen tüm arkadaşlara teşekkür eder saygılar sunarım.

İyi çalışmalar
 
Korhan Bey Merhaba,

Print #1, Range("A" & i).Text & ";" & Range("B" & i).Text & ";" & Range("C" & i).Text & _
";" & Range("D" & i).Text & ";" & Range("E" & i).Text & ";" & Range("F" & i).Text & ";" & Range("G" & i).Text & _
";" & Range("H" & i).Text & ";" & Range("I" & i).Text & ";" & Range("j" & i).Text & ";" & Range("k" & i).Text

Kırmızı olan I, J, K sütünlarını CSV oluştur dediğimde sadece;

"KDV_08"
"KDV_Dahil_18"
"KDV_18"

Satır sonlarına boş küçük bir kutu koyuyor. Sanırım boşluk bırakıyor.
Tabiki CSV dosyasında kutu karakteri gözükmüyor. Muhasebe programına çektiğimde orada gözüküyor.

Yukarıdaki kodlarda veya başka bir satırda boşluk olabilecek bir şey ben göremedim. Bu nerden kaynaklandığını çözemedim.

Saygılar,
 
11 nolu mesajımda ki kodu güncelledim. Tekrar deneyiniz.
 
Teşekkürler Korhan Bey deneyeceğim.

Elinize sağlık
 
Geri
Üst