csv dosylarını otomatik xlsx şekline çevirebilirmiyiz.

[Korhan Ayhan]

Merhaba,

Arşiv konularıda faydalı olabilir..

Arşiv Konuları

 

[engin.kilic.73]

eğer sütun sayıları tüm CSV dosyalarında AYNI ise dizi ile belki daha hızlanması sağlanabilir

Çok teşkkür ederim. deneyeceğim.

 

[hamitalper]

Merhaba, türkçe karakterleri bozuk gösteriyor bununla ilgili bir çözüm varmı acaba

 

[tugkan]

Merhaba, türkçe karakterleri bozuk gösteriyor bununla ilgili bir çözüm varmı acaba

Bozuk görünen Türkçe karakterleri düzeltmek istiyorsun. Örneğin, "ç" yerine "ç", "Ä°" yerine "İ" gibi karakter dönüşümlerini yaparak düzgün Türkçe karakterlere çevirmek gerekiyor.

Aşağıdaki VBA makrosu, bozuk görünen Türkçe karakterleri doğru karakterlerle değiştirecek şekilde tasarlandı:

Bozuk Türkçe Karakterleri Düzeltme Makrosu

Sub BozukTurkceKarakterleriDuzelt()
    Dim hücre As Range
    Dim eskiDeger As String
    Dim yeniDeger As String
    
    ' Aktif sayfadaki tüm hücrelerde dolaş
    For Each hücre In ActiveSheet.UsedRange
        If Not IsEmpty(hücre.Value) Then
            eskiDeger = hücre.Value
            
            ' Bozuk Türkçe karakterleri düzeltme
            yeniDeger = eskiDeger
            yeniDeger = Replace(yeniDeger, "ç", "ç")
            yeniDeger = Replace(yeniDeger, "Ç", "Ç")
            yeniDeger = Replace(yeniDeger, "ı", "ı")
            yeniDeger = Replace(yeniDeger, "Ä°", "İ")
            yeniDeger = Replace(yeniDeger, "ö", "ö")
            yeniDeger = Replace(yeniDeger, "Ö", "Ö")
            yeniDeger = Replace(yeniDeger, "ÅŸ", "ş")
            yeniDeger = Replace(yeniDeger, "Å", "Ş")
            yeniDeger = Replace(yeniDeger, "ü", "ü")
            yeniDeger = Replace(yeniDeger, "Ãœ", "Ü")
            yeniDeger = Replace(yeniDeger, "ÄŸ", "ğ")
            yeniDeger = Replace(yeniDeger, "Äž", "Ğ")
            
            ' Değişiklik yapıldıysa hücreyi güncelle
            If eskiDeger <> yeniDeger Then
                hücre.Value = yeniDeger
            End If
        End If
    Next hücre
    
    MsgBox "Bozuk Türkçe karakterler düzeltildi!", vbInformation
End Sub

Nasıl Çalıştırılır:

1. Excel'de Alt + F11 tuşlarına basarak VBA Düzenleyicisi'ni açın.
2. Menüden Insert > Module seçeneğini tıklayın.
3. Açılan modüle yukarıdaki kodu yapıştırın.
4. Alt + F8 tuşlarına basarak makroyu çalıştırın ve BozukTurkceKarakterleriDuzelt makrosunu seçin.

Bu makro, çalışma sayfasındaki bozuk görünen Türkçe karakterleri düzeltecektir.

 

[haliliyas]

aşağıdaki kodu dener misiniz?
Türkçe karakter desteği için CreateObject("ADODB.Stream") ile .Charset = "UTF-8" kullanılmıştır

Sub CSV_Stream_hy()
    Dim folderPath As String
    Dim csvFile As String
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim fileName As String
    Dim newWorkbook As Workbook
    Dim saveFilePath As String
    Dim csvData As String
    Dim lineData As Variant
    Dim i As Long
    
    ' Klasör yolunu tanımlayın
    folderPath = ThisWorkbook.Path & "\"
    
    ' Yeni bir çalışma kitabı oluştur
    Set newWorkbook = Workbooks.Add
    Set ws = newWorkbook.Sheets(1)
    ws.Cells.Clear ' Önceki verileri temizleyin
    
    ' Klasördeki ilk CSV dosyasını al
    Set oStreamUTF8 = CreateObject("ADODB.Stream")
    fileName = Dir(folderPath & "*.csv")
    With oStreamUTF8
        .Charset = "UTF-8"
        .Type = 2 'adTypeText
        .Open
    Do While fileName <> ""
    dosya = ThisWorkbook.Path & "\" & fileName ': Debug.Print dosya
           .LoadFromFile dosya
            xVeri = Left(fileName, InStrRev(fileName, ".") - 1) 'dosya adını al

            Do While Not oStreamUTF8.EOs
            csvData = oStreamUTF8.ReadText(-2)
                xSemiCol = InStr(InStr(csvData, ";") + 1, csvData, ";")
                ' Satırı ayır ve hücrelere yaz
                csvData = Left(csvData, xSemiCol) & xVeri & Mid(csvData, xSemiCol)
                lineData = Split(csvData, ";") ' CSV'deki ayırıcıyı ";" olarak ayarlayın

                ' Son boş satırı bul
                lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1

                ' Verileri ayrı hücrelere yaz
                For i = LBound(lineData) To UBound(lineData)
                    ws.Cells(lastRow, i + 1).Value = Trim(lineData(i)) ' Verileri yazarken boşlukları temizle
                Next i
            Loop
    fileName = Dir()
    Loop
    .Close
    End With

    
    ' Birleştirilen dosyanın kaydedileceği dosya yolunu belirleyin
    saveFilePath = folderPath & "Birlesmis_Dosya.xlsx"
    
    ' Yeni çalışma kitabını kaydet
    newWorkbook.SaveAs fileName:=saveFilePath, FileFormat:=xlOpenXMLWorkbook
    newWorkbook.Close
    
    MsgBox "CSV dosyaları birleştirildi ve '" & saveFilePath & "' olarak kaydedildi!"
End Sub

 

[haliliyas]

kodda unuttuğum bir yer vardı, orayı düzelttim
kodu tekrar dener misiniz?

 

[Asri]

Hepsini tek dosyada birleştirmek için
komut satırında, ilgili klasöründe içinde bu komutu çalıştırın.

Hala çalışıyor olması güzell )

type *.csv >> liste.xls