Txt satırına bilgi aktarmak

[kagakadir]

Arkadaşlar merhaba
Exeldeki bilgileri txt dosyasına göndermek istiyorum ama şu şekilde
örnek txt satırı şu şekilde olsun
Satır : A 4 AYSE 45 MEHMET 12

satırın 1. karakteri olan A Exelde belirteceğim bir hücreden
satırın 2-4 arası karakteri Exelde belirteceğim farklı bir hücreden
satırın 5-10 arası karakteri Exelde belirteceğim farklı bir hücreden
satırın 11-23 arası karakteri Exelde belirteceğim farklı bir hücreden
....,.
.....
ayrıca mesela 5-10 arasına tanımlayacagımız hücredeki bilgi 3 karakterden oluşuyorsa (ali, gibi) boşlukboşlukali
şeklinde yapmam lazım yani eksikleri boşlukla tamamlaması gerekiyor
umarım anlatabilmişimdir şimdiden teşekkür ederim

bir çok yerde araştırdım ama bunu yapabileceğim bir örnek bulamadım
yardımcı olursanız sevinirim

 

[veyselemre]

Aşağıdaki gibi random erişimli yapabilirsiniz.
Boşlukları alanların sonunda verecektir.
Rastgele erişimli dosyada satır sonu vermez. Uzunluğa dayalı rastgele erişim imkanı vardır.
Bu şekilde işinizi görmezse örnek excel dosyanızı ve istediğiniz txt dosyalarını örnek olarak eklerseniz iyi olur.

Type Record
    ALAN1 As String * 1
    ALAN2 As String * 3
    ALAN3 As String * 6
    ALAN4 As String * 13
End Type

Sub putData()
    Dim myRecord As Record
    Open Environ("userprofile") & "\desktop\test.txt" For Random As #1 Len = Len(myRecord)
    For i = 2 To Cells(Rows.Count, 1).End(3).Row
        myRecord.ALAN1 = Cells(i, 1)
        myRecord.ALAN2 = Cells(i, 2)
        myRecord.ALAN3 = Cells(i, 3)
        myRecord.ALAN4 = Cells(i, 4)
        Put #1, i - 1, myRecord
    Next i
    Close #1
End Sub

Sub getData()
    Dim myRecord As Record
    numRecs = Len(myRecord)
    Open Environ("userprofile") & "\desktop\test.txt" For Random As #1 Len = Len(myRecord)
    numRecs = LOF(1) \ numRecs
    For i = 1 To numRecs
        Get #1, i, myRecord
        Cells(i + 1, 1) = myRecord.ALAN1
        Cells(i + 1, 2) = myRecord.ALAN2
        Cells(i + 1, 3) = myRecord.ALAN3
        Cells(i + 1, 4) = myRecord.ALAN4
    Next i
    Close #1
End Sub

 

[kagakadir]

cok tesekkür ederim deneyip bilgi vereceğim

 

[kagakadir]

hocam olmadı
dosyalrı eklemeyi bulamadım nerden ekliyoruz yardımcı olurmusunuz forumda yeniyim kusura bakmayın

 

[Haluk]

Hani başka bir yerde görsem, "bu kodu ben yazmıştım....." derdim.

"Type" kullanımı, değişkenler, prosedür adı ..... tipik ben

Çok eskidendi..... Moderatör arkadaşlardan birisi benim IP ile Veysel Beyin IP'lerimizin aynı olduğunu ve aynı Nick'i kullanıp kullanmadığımı sormuştu ...

 

[Korhan Ayhan]

Aynı okulda okumuş olabilir misiniz?

 

[Haluk]

Bak, işte bu da olabilir ....... Mantıklı.

.

 

[kagakadir]

hocam txt dosyası aşağıdaki gibi olacak
her grup excelin belirtilen hücrelerinden alınacak
yani ilk satır için konusursak
A ,
320
C
1247016001100
,,,
Hepsi farklı hücrelerden alınacak

A 320              C  1247016001100   0   0   0   0   30513250   305AKA AMBALAJ SAN.TIC.001174-0  1 33420002--AMB       1770 660   0   0   0   0   27623250   552OZLEN AMBALAJ SAN TI001180-0    80800062--AMB       TL3115            F90   TL3100           
A 330              C  1247013801020   0   0   0   0   27623250   552AKA AMBALAJ SAN.TIC.001173-0  1 33420001--AMB       2135  70 245  70   0   0   17813250   178YAGMUROGLU DAYANiKLi001153-0    30350141--AMB       TL3115            F90   TL3100

 

[veyselemre]

Hani başka bir yerde görsem, "bu kodu ben yazmıştım....." derdim.

"Type" kullanımı, değişkenler, prosedür adı ..... tipik ben

Çok eskidendi..... Moderatör arkadaşlardan birisi benim IP ile Veysel Beyin IP'lerimizin aynı olduğunu ve aynı Nick'i kullanıp kullanmadığımı sormuştu ...

Ekli dosyayı görüntüle 225194

Teşbihte hata olmasın, "Kır atın yanında duran, ya huyundan, ya suyundan alır" derler, ister istemez, farkında olmadan insan esinleniyor veya güzel şeyleri kendine örnek alıyor.
Yalnız ben sizin yazmadığınızı bilirdim, 2 - 3 tane değişken tanımlaması yapılmamış.

Aynı okulda okumuş olabilir misiniz?

Bak, işte bu da olabilir ....... Mantıklı.

Çok isterdim mühendis olmayı ama ben Uludağ Maliye mezunuyum. 1989 'da sadece bir ay Gwbasic eğitimi aldım. Matematiğim iyi olduğu için algoritma mantığını çok iyi kavradım. Ama çok uzun süre (2005 yılında foruma üye olana kadar) hiç bir programlamayla uğraşmadım. İnternet sayesinde biraz geliştirdik bu işleri. En büyük eksikliğini hissettiğim konu ingilizce.. Bizde açığı @Haluk bey gibi foruma değer katan bir kaç arkadaştan esinlenerek kapatmaya çalışıyoruz.

 

[veyselemre]

Gereksiz yere uğraşmamak adına excel dosyanızı ve çalışan txt dosyanızı wetransfer, dosya.co, gibi paylaşım sitelerinden birisine atıp, burada linkini paylaşabilirsiniz. Ondalıklı sayı var mı, ondalık simgesi ne, tarih formatı var mı, formatı ne gibi ayrıntılar varsa örneklendirin.

 

[Haluk]

Veysel Bey, 10 numara adamsın vesselam ....

.

 

[kagakadir]

Gereksiz yere uğraşmamak adına excel dosyanızı ve çalışan txt dosyanızı wetransfer, dosya.co, gibi paylaşım sitelerinden birisine atıp, burada linkini paylaşabilirsiniz. Ondalıklı sayı var mı, ondalık simgesi ne, tarih formatı var mı, formatı ne gibi ayrıntılar varsa örneklendirin.

veysel bey ilginiz ve sabriniz için teşekkür ederim
dosyaları yükledim
asıl olan txt dosyasıdır exeldeki hücre yerleri değişebilir
siz gönderdiğim excele göre yazabilirseniz memnun olurum

test.rar

1 file sent via WeTransfer, the simplest way to send your files around the world

we.tl

 

[veyselemre]

Sub writeTextFile()

    Dim alan(1 To 26), uz(), lR()
    Dim i&, ii&
    uz = Array(0, 1, 4, 15, 11, 4, 4, 4, 4, 4, 11, 6, 30, 2, 20, 8, 4, 4, 4, 4, 11, 6, 32, 20, 18, 7, 18)
    lR = Array(0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1)
    
    Open Environ("userprofile") & "\desktop\test2.txt" For Output As #1

    For i = 1 To Cells(Rows.Count, 1).End(3).Row
        For ii = 1 To 26
            If lR(ii) = 1 Then
                alan(ii) = Left(Cells(i, ii).Value & Space(32), uz(ii))
            Else
                alan(ii) = Right(Space(32) & Cells(i, ii).Value, uz(ii))
            End If
        Next ii
        Print #1, Join(alan, "")
    Next i

    Close #1

End Sub

 

[kagakadir]

Sub writeTextFile()

    Dim alan(1 To 26), uz(), lR()
    Dim i&, ii&
    uz = Array(0, 1, 4, 15, 11, 4, 4, 4, 4, 4, 11, 6, 30, 2, 20, 8, 4, 4, 4, 4, 11, 6, 32, 20, 18, 7, 18)
    lR = Array(0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1)
   
    Open Environ("userprofile") & "\desktop\test2.txt" For Output As #1

    For i = 1 To Cells(Rows.Count, 1).End(3).Row
        For ii = 1 To 26
            If lR(ii) = 1 Then
                alan(ii) = Left(Cells(i, ii).Value & Space(32), uz(ii))
            Else
                alan(ii) = Right(Space(32) & Cells(i, ii).Value, uz(ii))
            End If
        Next ii
        Print #1, Join(alan, "")
    Next i

    Close #1

End Sub

hocam gerçekten çok teşekkür ederim
kod sorunsuz çalışıyor
allah razı olsun