Listeden Text Dosya Oluşturma

[bluefalcon]

Arkadaşlar Merhaba,

Ekte gönderdiğim listede gerekli açıklamaları yaptım. Verilen bir listede ilgili satırın adında sekme ile ayrılmış txt dosyası oluşturarak belirli verileri içerisine yazan bir makro olabilir mi? Excel'in herşeyin üstesinden geldiğini biliyorum. Bunuda halledebileceğini düşünüyorum yardımlarınızla....Şimdiden teşekkür ederim.

 

[parsley2]

txt

Open "c:\Veri\deneme.txt" For output As #1
For i= 1 to 10
print #1, cells(i,1), cells(i,2)
next i
Close
bunu senin dosyana uygularsan başarabilirsin

 

[bluefalcon]

parsley2 arkadaşım ilgilendiğin için teşekkür ediyorum. Yalnız istediğim bu değil.Yani verileri text dosyaya geçirmek değil niyetim. Seninde yaptığın gibi programın bir text dosyası oluşturması ve bu text dosyanın adının verileri kaydettiği kişilerin firma adı olması gerekiyor.Yani a şirketindeki belirli bir sicil aralığındaki kişilerin a.txt dosyasında olması gerekiyor. Ayrıca dosyadaki verilerin tek sekme ile ayrılmış olarak yer alması bal üstüne kaymak olur.

 

[bluefalcon]

yok mu arkadaşlar bir yardımı dokunacak babayigit....

 

[bluefalcon]

anlaşılan karmaşık bir soru oldu... Yanıt gelmedi....

 

[Haluk]

Sub Test()
    Dim i As Long, j As Long, NoA As Long, FileNum As Long
    Dim LogFile As String
    If Dir("C:\Firmalar", vbDirectory) = Empty Then MkDir "C:\Firmalar"
    NoA = Cells(65536, 1).End(xlUp).Row
    For i = 2 To NoA
        LogFile = "C:\Firmalar\" & Cells(i, 1) & ".txt"
        FileNum = FreeFile
        Open LogFile For Output As FileNum
            For j = 2 To NoA
                If Cells(j, 1) = Cells(i, 1) Then
                    Print #FileNum, Cells(j, 2), Cells(j, 3), Cells(i, 4), Cells(j, 5)
                End If
            Next
        Close FileNum
    Next
End Sub

 

[bluefalcon]

Haluk dostum teşekkür ederim. İstediğim şekilde dosya oluşturuyor. Ancak text dosyasındaki veriler tek boşluk ile birbirinden ayrılabilir mi? Yani ARICAN 10100 10 şeklinde.İlgilenirsen memnun olurum.

 

[veyselemre]

Haluk beyin izniyle kodlara çalışma sayısını azaltmak için bir ekleme yapmak istiyorum.

Sub Test()
    Dim i As Long, j As Long, NoA As Long, FileNum As Long
    Dim LogFile As String
    If Dir("D:\Firmalar", vbDirectory) = Empty Then MkDir "D:\Firmalar"
    NoA = Cells(65536, 1).End(xlUp).Row
    For i = 2 To NoA
 
  [COLOR=Red]      If WorksheetFunction.CountIf(Range("a2:a" & i), Cells(i, 1)) > 1 Then GoTo atla[/COLOR]

        LogFile = "D:\Firmalar\" & Cells(i, 1) & ".txt"
        FileNum = FreeFile
        Open LogFile For Output As FileNum
            For j = 2 To NoA
                If Cells(j, 1) = Cells(i, 1) Then
                    veri = Cells(j, 1) & " " & Cells(j, 2) & " " & Cells(j, 5)
                    Print #FileNum, veri
                End If
            Next
        Close FileNum
[COLOR=Red]atla:[/COLOR]
     Next
End Sub

 

[Haluk]

Sub Test()
    Dim i As Long, j As Long, NoA As Long, FileNum As Long
    Dim LogFile As String
    If Dir("C:\Firmalar", vbDirectory) = Empty Then MkDir "C:\Firmalar"
    NoA = Cells(65536, 1).End(xlUp).Row
    For i = 2 To NoA
        LogFile = "C:\Firmalar\" & Cells(i, 1) & ".txt"
        FileNum = FreeFile
        Open LogFile For Output As FileNum
            For j = 2 To NoA
                If Cells(j, 1) = Cells(i, 1) Then
                    Print #FileNum, Cells(j, 2) & Space(1) & Cells(j, 3) & Space(1) & Cells(j, 4) & Space(1) & Cells(j, 5)
                End If
            Next
        Close FileNum
    Next
End Sub

 

[bluefalcon]

hepinize çok teşekkür ediyorum güzel insanlar..saolun varolun......