Csv formatlı dosyaları birleştirmek

[cavanoos]

Merhaba arkadaşlar;

Bankadan bize gönderilen csv formatlı dosyalar var.Ben bu dosyaları tek bir excel sayfasında birleştirmek istiyorum.Birleştirme için makro kodum var ama sadece xls uzantılı dosyaları birleştiriyor.Csv yi de birleştiriyor ama hücreler bozuk olarak birleşiyor.

1-Csv formatlı dosyaları düzgün bir şekilde nasıl birleşiririm.
2-Birleştiremediğimizi düşünelim.O zaman,Csv formatlı dosyaları farklı kaydet yapıp,xls formatında kaydedecek makro kodu yazabilir miyiz?

Birleştirme için kullandığım makro kodum alttadır.Yardım edebilir misiniz ?


Sub Birlestir()
Dim AktifDosya As Workbook
Dim Dosya As Workbook
Dim DosyaAdi

Set AktifDosya = ActiveWorkbook

With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = True
.Title = "Birleştirilecek Dosyaları Seçin"

If .Show Then
For Each DosyaAdi In .SelectedItems
Set Dosya = Workbooks.Open(DosyaAdi)

Dosya.Worksheets(1).UsedRange.Copy AktifDosya.Worksheets(1).Range("A65536").End(xlUp)(2, 1)

Dosya.Close False
Set Dosya = Nothing
Next
End If
End With

Set AktifDosya = Nothing
End Sub

 

[halit3]

Merhaba arkadaşlar;

Bankadan bize gönderilen csv formatlı dosyalar var.Ben bu dosyaları tek bir excel sayfasında birleştirmek istiyorum.Birleştirme için makro kodum var ama sadece xls uzantılı dosyaları birleştiriyor.Csv yi de birleştiriyor ama hücreler bozuk olarak birleşiyor.

1-Csv formatlı dosyaları düzgün bir şekilde nasıl birleşiririm.
2-Birleştiremediğimizi düşünelim.O zaman,Csv formatlı dosyaları farklı kaydet yapıp,xls formatında kaydedecek makro kodu yazabilir miyiz?

Birleştirme için kullandığım makro kodum alttadır.Yardım edebilir misiniz ?


Sub Birlestir()
Dim AktifDosya As Workbook
Dim Dosya As Workbook
Dim DosyaAdi

Set AktifDosya = ActiveWorkbook

With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = True
.Title = "Birleştirilecek Dosyaları Seçin"

If .Show Then
For Each DosyaAdi In .SelectedItems
Set Dosya = Workbooks.Open(DosyaAdi)

Dosya.Worksheets(1).UsedRange.Copy AktifDosya.Worksheets(1).Range("A65536").End(xlUp)(2, 1)

Dosya.Close False
Set Dosya = Nothing
Next
End If
End With

Set AktifDosya = Nothing
End Sub

Örnek bir kaç tane dosya eklermisinz

 

[cavanoos]

Halit Bey;

Ekteki dosya örneklerini birleştirmek istiyorum..

 

[halit3]

Halit Bey;

Ekteki dosya örneklerini birleştirmek istiyorum..

bu konu daha önce burada işlenmişti adresi bende bulamadım.

ekli dosyayı inceleyiniz.

 

[cavanoos]

Halit Bey;

Butona basıyorum.Masaüstünde klasörü gösteriyorum.Ama sonuç yok.

Nasıl işlem yapmam lazım.Ben anlamadım...

 

[halit3]

Klasörü d sürücüsüne al veya belgelerim klasörünün içine al yeniden dene

 

[cavanoos]

Halit Bey;

Çok teşekkür ederim.Güzel oldu.Yalnız bilginiz olsun.Birleştirilen her dosyanın en alt satırı düzgün gelmiyor.Manuel olarak düzeltiyorum.

 

[halit3]

Birde bunu dene kodları kısalttım.

 

[cavanoos]

Halit Bey;

Daha kısa sürede birleştirme yaptı.Ancak son satırlar düzgün gelmedi.Bilginiz olsun...

 

[halit3]

son satır nasıl geliyor anlamadım

 

[cavanoos]

Halit Bey;

Geciktim özür dilerim.Son satır aşağıdaki gibi tek bir sütunda geliyor.


13.02.2011;PT9238292 BONUS 11/14 K: 0,00 ;163,41;234334,87

 

[halit3]

Halit Bey;

Geciktim özür dilerim.Son satır aşağıdaki gibi tek bir sütunda geliyor.


13.02.2011;PT9238292 BONUS 11/14 K: 0,00 ;163,41;234334,87

Buraya eklediğin örnek dosyanda böyle bir veri yok

 

[cavanoos]

Örnek dosyadan değil bu.İşlem yaptığım dosyadan.Onların boyutları 4000 satırı buluyor.

 

[halit3]

satır = ver.Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row [COLOR=red]+1[/COLOR]

yukarıdaki bölümün sonuna +1 yapıp denermisiniz.

 

[cavanoos]

Halit Bey;

Değişen bir şey olmadı.Bu kadarı bile benim için yeterli.Saolun.

 

[halit3]

gelmiyen veriye ait son üsten satırları sil yanlızca son 10 satır kalsın

son 10 satırın altını hiç silmeden buraya bir ekle

yani 4000 satırlık bir verin varsa 1 den 3990 a adar olan satırları sil ve kayıt et buraya ekle hatanın nereden kaynaklandığını görelim.

 

[cavanoos]

Halit Bey;

Neden olduğunu anladım.Size örnek olarak hazırladığım dosyada ilk satır dolu idi.İlk satır dolu ise sorun yok.Orjinal dosyalarda ise ilk satırlar boş.Boş satırları kaldırdıktan sonra yaptığımda oluyor.

 

[halit3]

Birde bu dosyayı dene son satırdaki veri kalacakmı

 

[cavanoos]

Halit Bey;

Şimdi oldu.Elinize sağlık.

 

[halit3]

Halit Bey;

Şimdi oldu.Elinize sağlık.

iyi çalışmalar