TxT oluşturma

[akmes]

Merhaba,

Excel de sayfada kayıtlı birden fazla veriye ayrı ayrı txt dosyası oluşturma işlemi yapabilir miyiz yani biraz daha açarsak ekteki excel dosyasından da anlaşılacağı gibi B sütununa göre girilen bilgilerden bazı değerlerini alarak otomatik txt oluşturabileceğimiz bir kod yazılabilir mi? Ben mesaj ekinde elle yapılmış örnek bir txt dosyası da ekledim.Konu ile ilgili yardımlarınızı rica ediyorum.Oluşacak txt ler excel dosyasının bulunduğu klasörde olabilirler.Şimdiden ilginize çok teşekkür ederim.

 

[Murat OSMA]

Şu kodları bir deneyiniz;

Sub Rky_Txt_Yap()
    Dim i As Integer, m As Integer
    Columns("B:B").Select
    Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
    For i = 2 To Range("B65536").End(3).Row Step 2
        If Cells(i, 3) <> "" Then
        Open ThisWorkbook.Path & "\" & Cells(i, 3) & ".txt" For Output As #1
        Print #1, Cells(i + 1, 2)
        Close #1
        End If
    Next i
    i = Empty: m = Empty
End Sub

 

[akmes]

Şu kodları bir deneyiniz;

Sub Rky_Txt_Yap()
    Dim i As Integer, m As Integer
    Columns("B:B").Select
    Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
    For i = 2 To Range("B65536").End(3).Row Step 2
        If Cells(i, 3) <> "" Then
        Open ThisWorkbook.Path & "\" & Cells(i, 3) & ".txt" For Output As #1
        Print #1, Cells(i + 1, 2)
        Close #1
        End If
    Next i
    i = Empty: m = Empty
End Sub

Üstadım istediğim gibi olmuş, emeğinize sağlık çok teşekkür ederim.

 

[Murat OSMA]

Rica ederim, iyi akşamlar... k::