• DİKKAT

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

Csv dosyayı xls formatına çevirme

I

istanbulcahan

Katılım
11 Ocak 2008
Mesajlar
1,395
Excel Vers. ve Dili
Office 365 (Türkçe)
Reseller hosting kontrol panelinde ad soyad site bilgilerinizi içeren csv dosyanın xls e çevrilmesi nasıl olur.dosya ekte.
 

Ekli dosyalar

istanbulcahan' Alıntı:
Reseller hosting kontrol panelinde ad soyad site bilgilerinizi içeren csv dosyanın xls e çevrilmesi nasıl olur.dosya ekte.
Genişletmek için tıkla ...

Kodu boş bir modüle kopyalayın

Kod: 
Sub veri_al()
ThisWorkbook.Sheets(ActiveSheet.Name).Range(Cells(2, 1), Cells(Rows.Count, Columns.Count)).ClearContents
Dim sayfa_adi As String
Dosya = Application.GetOpenFilename(filefilter:="Text dosyaları (*.txt), *.txt", Title:="Import Data From...")
If Dosya = "False" Then
Exit Sub
End If
sayfa_adi = Dir(Dosya)
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & Dosya, Destination:=Range("A1"))
.Name = sayfa_adi
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.Refresh BackgroundQuery:=False
End With
Range("a1").Select
Dim qt As QueryTable
For Each qt In ActiveSheet.QueryTables
qt.Delete
Next qt
Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True
Selection.ColumnWidth = 26.14
Range("a1").Select

MsgBox "işlem tamam"
End Sub
 
halit3' Alıntı:
Kodu boş bir modüle kopyalayın

Kod: 
Sub veri_al()
ThisWorkbook.Sheets(ActiveSheet.Name).Range(Cells(2, 1), Cells(Rows.Count, Columns.Count)).ClearContents
Dim sayfa_adi As String
Dosya = Application.GetOpenFilename(filefilter:="Text dosyaları (*.txt), *.txt", Title:="Import Data From...")
If Dosya = "False" Then
Exit Sub
End If
sayfa_adi = Dir(Dosya)
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & Dosya, Destination:=Range("A1"))
.Name = sayfa_adi
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.Refresh BackgroundQuery:=False
End With
Range("a1").Select
Dim qt As QueryTable
For Each qt In ActiveSheet.QueryTables
qt.Delete
Next qt
Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True
Selection.ColumnWidth = 26.14
Range("a1").Select

MsgBox "işlem tamam"
End Sub
Genişletmek için tıkla ...

Merhabalar,
ekli csv dosyasını excel ortamına alırken değerleri aradaki nokta işaretlerini almıyor ; csv dosyasındaki veriyi metin olarak algılayıp, aynen ne yazıyorsa bire-bir aynı şekilde alsın.

1.4359 >> 14359
1.1608 >> 11608

excel'e bu şekilde alıyor.

olması gereken ise bire-bir aynısı

teşekkürler,

iyi çalışmalar.
 

Ekli dosyalar

tamer42' Alıntı:
Merhabalar,
ekli csv dosyasını excel ortamına alırken değerleri aradaki nokta işaretlerini almıyor ; csv dosyasındaki veriyi metin olarak algılayıp, aynen ne yazıyorsa bire-bir aynı şekilde alsın.

1.4359 >> 14359
1.1608 >> 11608

excel'e bu şekilde alıyor.

olması gereken ise bire-bir aynısı

teşekkürler,

iyi çalışmalar.
Genişletmek için tıkla ...

Tam olarak ne dediğinizi anlayamadım ben ofis 2003 kullanıyorum aşağıdaki kod csv formatındaki kapalı bir dosyadan verileri ayrıştırarak almaktadır.

kod:

Kod: 
Sub veri_al()
ThisWorkbook.Sheets(ActiveSheet.Name).Range(Cells(2, 1), Cells(Rows.Count, Columns.Count)).ClearContents
Dim sayfa_adi As String

Dosya = Application.GetOpenFilename(filefilter:="Text dosyaları (*.csv), *.csv", Title:="Import Data From...")

If Dosya = "False" Then
Exit Sub
End If
sayfa_adi = Dir(Dosya)
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & Dosya, Destination:=Range("A1"))
.Name = sayfa_adi

.RefreshOnFileOpen = False
.RefreshStyle = xlOverwriteCells
.Refresh BackgroundQuery:=False

End With
Range("a1").Select
Dim qt As QueryTable
For Each qt In ActiveSheet.QueryTables
qt.Delete
Next qt
Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True

Selection.ColumnWidth = 26.14
Range("a1").Select

MsgBox "işlem tamam"
End Sub
 

Ekli dosyalar

Alternatif;
Kod: 
[FONT="Trebuchet MS"]Dim yol As String
Private Sub UserForm_Initialize()
    Dim Rky As Object, Evn As Object
    yol = ThisWorkbook.Path
    Set Rky = VBA.CreateObject("Scripting.FilesystemObject")
    For Each Evn In Rky.getfolder(yol).Files
        If Right(Evn.Name, 3) = "txt" Then ComboBox1.AddItem Split(Evn.Name, ".")(0)
    Next Evn
End Sub

Private Sub ComboBox1_Change()
    Dim con As Object, rs As Object
    Set con = VBA.CreateObject("Adodb.Connection")
    con.Open "Driver={Microsoft Text Driver (*.txt; *.csv)};Dbq=" & _
    yol & ";Extensions=asc,csv,tab,txt;"
    Set Rky = CreateObject("Scripting.FilesystemObject")
    For Each Evn In Rky.getfolder(yol).Files
        Set rs = con.Execute("Select * from [" & Evn.Name & "]")
        Do While Not rs.EOF
            On Error Resume Next
            Range("A1").CopyFromRecordset rs
        Loop
        Exit For
    Next Evn
    con.Close
    Set con = Nothing: Set rs = Nothing
End Sub[/FONT]
 

Ekli dosyalar

Merhaba halit3 txt dosya formatını zannedersem virgülle hücrelere ayırıyor bunu noktalı virgülle yapabilir miyiz..
kesenek dosya hazırlama noktalı virgülle ayırıyor.
 
polis-53' Alıntı:
Merhaba halit3 txt dosya formatını zannedersem virgülle hücrelere ayırıyor bunu noktalı virgülle yapabilir miyiz..
kesenek dosya hazırlama noktalı virgülle ayırıyor.
Genişletmek için tıkla ...

kod:

Kod: 
Sub veri_al()
ThisWorkbook.Sheets(ActiveSheet.Name).Range(Cells(2, 1), Cells(Rows.Count, Columns.Count)).ClearContents
Dim sayfa_adi As String

Dosya = Application.GetOpenFilename(filefilter:="Text dosyaları (*.csv), *.csv", Title:="Import Data From...")

If Dosya = "False" Then
Exit Sub
End If
sayfa_adi = Dir(Dosya)
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & Dosya, Destination:=Range("A1"))
.Name = sayfa_adi

.RefreshOnFileOpen = False
.RefreshStyle = xlOverwriteCells
.Refresh BackgroundQuery:=False

End With
Range("a1").Select
Dim qt As QueryTable
For Each qt In ActiveSheet.QueryTables
qt.Delete
Next qt
Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=[COLOR="Red"]True[/COLOR], Comma:=[COLOR="red"]False[/COLOR], Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True

Selection.ColumnWidth = 26.14
Range("a1").Select

MsgBox "işlem tamam"
End Sub
 
halit3' Alıntı:
Tam olarak ne dediğinizi anlayamadım ben ofis 2003 kullanıyorum aşağıdaki kod csv formatındaki kapalı bir dosyadan verileri ayrıştırarak almaktadır.

kod:

Kod: 
Sub veri_al()
ThisWorkbook.Sheets(ActiveSheet.Name).Range(Cells(2, 1), Cells(Rows.Count, Columns.Count)).ClearContents
Dim sayfa_adi As String

Dosya = Application.GetOpenFilename(filefilter:="Text dosyaları (*.csv), *.csv", Title:="Import Data From...")

If Dosya = "False" Then
Exit Sub
End If
sayfa_adi = Dir(Dosya)
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & Dosya, Destination:=Range("A1"))
.Name = sayfa_adi

.RefreshOnFileOpen = False
.RefreshStyle = xlOverwriteCells
.Refresh BackgroundQuery:=False

End With
Range("a1").Select
Dim qt As QueryTable
For Each qt In ActiveSheet.QueryTables
qt.Delete
Next qt
Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True

Selection.ColumnWidth = 26.14
Range("a1").Select

MsgBox "işlem tamam"
End Sub
Genişletmek için tıkla ...

Sn Halit ekli dosyada I2 hücresine bakarsanız
csv dosyasındaki 1.1608 değeri excel ortamına 11608 olarak geliyor.

iyi çalışmalar.
 

Ekli dosyalar

  • DOSYA.xls
    DOSYA.xls
    36 KB · Görüntüleme: 5
  • Ekran Alıntısı.JPG
    Ekran Alıntısı.JPG
    59.1 KB · Görüntüleme: 2
Örnek dosyanızda sayfa2 de bu kodu çalıştırın

not :kodu çalıştırmadan önce hücre biçimlendirme genel olmalı

kod:
Kod: 
Sub veri_al()
ThisWorkbook.Sheets(ActiveSheet.Name).Range(Cells(2, 1), Cells(Rows.Count, Columns.Count)).ClearContents
Dim sayfa_adi As String

Dosya = Application.GetOpenFilename(filefilter:="Text dosyaları (*.csv), *.csv", Title:="Import Data From...")

If Dosya = "False" Then
Exit Sub
End If
sayfa_adi = Dir(Dosya)

With Application
.DecimalSeparator = "."
.ThousandsSeparator = ","
End With

With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & Dosya, Destination:=Range("A1"))
.Name = sayfa_adi

.RefreshOnFileOpen = False
.RefreshStyle = xlOverwriteCells
.Refresh BackgroundQuery:=False

End With
Range("a1").Select
Dim qt As QueryTable
For Each qt In ActiveSheet.QueryTables
qt.Delete
Next qt
Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True

Range("a1").Select

With Application
.DecimalSeparator = ","
.ThousandsSeparator = "."
End With

MsgBox "işlem tamam"
End Sub
 
Sn Halit3 çok teşekkürler,
Şimdi tamam oldu,

Birde bu işlemin tersini EXCEL den CSV ye verebilirsen çok memnun olacağım.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst