csv uzantısından veri alma

ekoert

Altın Üye
Katılım
5 Ocak 2011
Mesajlar
137
Excel Vers. ve Dili
2007
Altın Üyelik Bitiş Tarihi
17-06-2026
Merhaba,
Kapalı csv uzantılı dosyadan makro yardımıyla veri almak istiyorum.
Sitede yer alan kapalı dosyadan veri alma konularının birçoğunu inceledim fakat sonuç alamadım.

Ekte yer alan dosyayı elle açıp kopyaladığımda bir sorun yok fakat kodla açtığımda eksik açıyor dosyayı.

Sebebini anlayamadım.
 

Ekli dosyalar

veyselemre

Özel Üye
Katılım
9 Mart 2005
Mesajlar
3,647
Excel Vers. ve Dili
Pro Plus 2021
csv dosyanızın 1. satırında " işaretleri yanlış (düzensiz) eklenmiş, 1.satırdaki " ları kaldırıp tekrar deneyin.
 

ekoert

Altın Üye
Katılım
5 Ocak 2011
Mesajlar
137
Excel Vers. ve Dili
2007
Altın Üyelik Bitiş Tarihi
17-06-2026
csv dosyanızın 1. satırında " işaretleri yanlış (düzensiz) eklenmiş, 1.satırdaki " ları kaldırıp tekrar deneyin.
Dosyayı manuel açıp, metni sütunlara dönüştür dediğimde hiçbir sorunla karşılaşmıyorum. Herbir sütunun altına ilgili hücreler gelmektedir.

Örnek makro dosyası(sorunlu) ektedir.

Özellikle Halit Bey'in hazırlamış olduğu çeşitli verialma kodlarını denedim, veriyi alma aşamasında eksik açmaktadır.
 

Ekli dosyalar

Son düzenleme:

veyselemre

Özel Üye
Katılım
9 Mart 2005
Mesajlar
3,647
Excel Vers. ve Dili
Pro Plus 2021
Deneyiniz;
Kod:
Sub test()
    Dosya = Application.GetOpenFilename("Excel Dosyası (*.csv),*.csv", , "Hedef Dosyayı Seçin")
    If Dosya = False Then Exit Sub
    Cells.ClearContents
    Open Dosya For Input As #1
        Do While Not EOF(1)
            Line Input #1, TextLine
            sat = sat + 1
            ver = Split(TextLine, "|")
            Cells(sat, 1).Resize(1, UBound(ver)) = ver
        Loop
    Close #1
    Rows("1:1").Replace What:=Chr(34), Replacement:=""
End Sub
 

ekoert

Altın Üye
Katılım
5 Ocak 2011
Mesajlar
137
Excel Vers. ve Dili
2007
Altın Üyelik Bitiş Tarihi
17-06-2026
Veysel Bey,

Çok teşekkürler, sorun çözülmüş. Fakat 41. sütuna kadar değerleri almış, Son(55.) sütundaki değerler boş geliyor.
 

ekoert

Altın Üye
Katılım
5 Ocak 2011
Mesajlar
137
Excel Vers. ve Dili
2007
Altın Üyelik Bitiş Tarihi
17-06-2026
Kod:
            Cells(sat, 1).Resize(1, UBound(ver) [B][COLOR="Red"]+ 1[/COLOR][/B]) = ver
Veysel Bey,

Harika, çok pratik olmuş.

Çok teşekkürler.

Sayıları metin gibi görüyor, pratik bir çözümü varsa sevinirim. Yoksa ayrı bir makroyla halledeceğim.
 
Son düzenleme:

ekoert

Altın Üye
Katılım
5 Ocak 2011
Mesajlar
137
Excel Vers. ve Dili
2007
Altın Üyelik Bitiş Tarihi
17-06-2026
Range("ES1").Copy
' BOŞ BİR HÜCREYİ KOPYALA
Range("a:bc").PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd

Siteden bulduğum makro kodu çok yavaşlatıyor.
 

veyselemre

Özel Üye
Katılım
9 Mart 2005
Mesajlar
3,647
Excel Vers. ve Dili
Pro Plus 2021
Kod:
Sub test()
    Dosya = Application.GetOpenFilename("Excel Dosyası (*.csv),*.csv", , "Hedef Dosyayı Seçin")
    If Dosya = False Then Exit Sub
    Cells.ClearContents
    Open Dosya For Input As #1
    Do While Not EOF(1)
        Line Input #1, TextLine
        sat = sat + 1
        ver = Split(TextLine, "|")
        Cells(sat, 1).Resize(1, UBound(ver) + 1) = ver
    Loop
    Close #1
    Rows("1:1").Replace What:=Chr(34), Replacement:=""
    [IV1].Clear
    [IV1].Copy
    For Each sut In Array("g", "m", "n", "o", "r") 'numeric sutunları düzenleyin.
        Columns(sut).PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd
    Next sut
    Application.CutCopyMode = False
    
    Cells.EntireColumn.AutoFit
End Sub
 
Son düzenleme:

ekoert

Altın Üye
Katılım
5 Ocak 2011
Mesajlar
137
Excel Vers. ve Dili
2007
Altın Üyelik Bitiş Tarihi
17-06-2026
Kod:
Sub test()
    Dosya = Application.GetOpenFilename("Excel Dosyası (*.csv),*.csv", , "Hedef Dosyayı Seçin")
    If Dosya = False Then Exit Sub
    Cells.ClearContents
    Open Dosya For Input As #1
    Do While Not EOF(1)
        Line Input #1, TextLine
        sat = sat + 1
        ver = Split(TextLine, "|")
        Cells(sat, 1).Resize(1, UBound(ver) + 1) = ver
    Loop
    Close #1
    Rows("1:1").Replace What:=Chr(34), Replacement:=""
    [IV1].Clear
    [IV1].Copy
    For Each sut In Array("g", "m", "n", "o", "r") 'numeric sutunları düzenleyin.
        Columns(sut).PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd
    Next sut
    Application.CutCopyMode = False
    
    Cells.EntireColumn.AutoFit
End Sub
Üstat çok teşekkürler.
 
Üst