veriyi iki ayrı sütuna yazdırmak

[k0081]

Merhaba arkadaşlar;

Private Sub CommandButton3_Click()
Dim dosya As String, d As String
Dim s As Long
Dim st, i As Integer
On Error Resume Next
dosya = Application.GetOpenFilename( _
            "Text Dosyaları (*.txt) (*.txt), *.txt", 1, _
            "ASCII koordinat data..")
s = 2
If dosya = "False" Then Exit Sub
    Open dosya For Input As #1
        While Not EOF(1)
           s = s + 1
            Line Input #1, d
                     st = 2
                     x = Split(d, " ")
                    For i = 0 To UBound(x)
                        st = st + 1
                        If x(i) = "" And i > 0 Then
End If
Cells(s, st) = x(i)
Next i
    Wend
    Close #1
    MsgBox "Dosya alımı tamamlandı.", vbInformation, _
    "ASCII Koordinat data.."
    If Err.Number <> 0 Then MsgBox Err.Description, vbExclamation, _
    "Hata..!"
End Sub

Ekli dosyayı görüntüle Drawing2.txt

göndermiş olduğum örnek kodda bir yerde hata yapıyorum ama bulamadım. ekteki drawing2.txt de ki gibi bir yazıyı buton yardımı ile alıyorum. fakat sadece C sütununa yazıyor.. yapmak istediğim : C ye 147,158 bu şekilde, D ye de 207,874 bunu yazarak devam etmesi...


yardımcı arkadaşlara şimdiden teşekkürler..

 

[Ömer]

Merhaba,

x = Split(d, " ")

Yukarı kod satırı yerine aşağıdaki kod satırını kullanın. Aradaki boşluk değil sekme karakteridir. ASCII karakter kodu 9 dur.

x = Split(d, Chr(9))

.

 

[k0081]

Merhaba,

hocam tamamdır.. teşekkür ederim.

Sanırım kaydet kısmında da hata yapıyorum.. (yine aynı format da bu sefer kayıt.)

****** bir karışıklar var hocam. Tekrar bir kontrol ettim de... şimdi öncelikle benim aldığım txt dosyada (size göndermiş olduğum değil..) boşluk var hocam. sekme değil... dolayısıyla x = Split(d, " ") bu kodu kullanıcağım..
aşağıdaki kod sanırım sekmeli kayıt yapıyor yada başka bişey var.. istediğim boşluklu kayıt yapması.

Private Sub CommandButton4_Click()
Dim dosya As String, s As Long, d As String
Dim arr() As String, c As Integer
Dim son_k As Long
 son_k = Worksheets(ActiveSheet.Name).Range("C65536").End(xlUp).Row
   
    dosya = Application.GetSaveAsFilename("", _
            "Koordinat dosyaları (*.txt) (*.txt), *.txt", 1, _
            "ASCII data kayıt..")
           
    If dosya = "False" Then Exit Sub
    On Error Resume Next
    
 If Range("C" & son_k) <> "" And Range("D" & son_k) <> "" Then
    ReDim arr(3 To son_k) As String
    Open dosya For Output As #1
    For s = 3 To son_k
            
            For c = 3 To son_k
                arr(c) = Cells(s, c)
            Next
            
            d = Join(arr, vbTab)
            
            Print #1, d
            Next
        Close #1
    MsgBox "Dosya kaydı tamamlandı.", vbInformation, _
    "ASCII Data kayıt.."
    
    If Err.Number <> 0 Then MsgBox Err.Description, vbExclamation, _
    "ASCII data kayıt.."
    End If
End Sub

 

[Necdet]

Merhaba,

hocam tamamdır.. teşekkür ederim.

Sanırım kaydet kısmında da hata yapıyorum.. (yine aynı format da bu sefer kayıt.)

****** bir karışıklar var hocam. Tekrar bir kontrol ettim de... şimdi öncelikle benim aldığım txt dosyada (size göndermiş olduğum değil..) boşluk var hocam. sekme değil... dolayısıyla x = Split(d, " ") bu kodu kullanıcağım..
aşağıdaki kod sanırım sekmeli kayıt yapıyor yada başka bişey var.. istediğim boşluklu kayıt yapması.

Merhaba,
Siz ne yapmak istiyorsunuz? Kodları değil ne yapmak istediğinizi yazarsanız konu daha iyi anlaşılır.

 

[k0081]

hocam kodları göndermem deki amaç o kodun içinde ekleme yapmaktı..

neyse ; şöyle yazayım :

Tabloma bir buton ekleyerek C3 ve D80 e kadar olan kısmı text dosyasına yazdırmak istiyorum..

örnek: excel tablo içeriği
C D
125421,326 154256,63
121535,315 12426,32
136456,634 154253,65
***********************************
gibi değerler mevcut excel tablomda..

bunları aralarında bir boşluk bırakarak ve virgül yerine nokta kullanarak text dosyasına kaydetmek. bunu yapmak istiyorum. (excel tabloma girişlerim virgülledir..) ama kayıt esnasında text dosyasında nokta olmasını istiyorum.

 

[Necdet]

Merhaba,

Aşağıdaki kodları dener misiniz?

Yol ve Dosya adını kendinize göre düzenleyiniz.

Sub Excel_Text()
 
    Dim i       As Long, _
        Satir   As String, _
        Yol     As String, _
        Dosya   As String
        
    Yol = "D:\"
    Dosya = "Deneme.txt"
    
    Open Yol & Dosya For Output As #1
    
    For i = 3 To 80
        Satir = Cells(i, "C") & " " & Cells(i, "D")
        Satir = Replace(Satir, ",", ".")
        Print #1, Satir
    Next i
    
    Close #1
    
    MsgBox "İŞLEM TAMAMLANDI..."
    
End Sub

 

[k0081]

Tamamdır.. Hocam elinize , yüreğinize sağlık.. çok teşekkürler..

 

[Necdet]

Tamamdır.. Hocam elinize , yüreğinize sağlık.. çok teşekkürler..

Güle güle kullanınız.