Text dosyadaki bilgileri line input ile alırken diziye nasıl alabilirim?

[Tevfik_Kursun]

Merhaba Arkadaşlar,

    Open (ThisWorkbook.Path & "\Txt\Ornek_TK1.txt") For Input As #2
        sat = 3
        Do While Not EOF(2)
            Line Input #2, b
                Cells(sat, 7).Value = b
                sat = sat + 1
        Loop
    Close #2

Bu makro ekli dosyayi satır satır 7. sütuna alıyor, alırken her satırı ayrı ayrı yazıyor. Bu dosya bir diziye alınıp bir seferde nasıl yazılır? (Örnek dosya, fazla özel bilgiler içerdiği için bu halde gönderdim. Her satır, açıldığında 61 hücreye dağılan özel bilgi içeriyor)
Bu sabah https://excel.web.tr/threads/makroyu-nasil-hizlandirabilirim.177572/ bu bağlantıyı görünce bu soru aklıma geldi. Yardımcı olursanız sevinirim.
Saygılarımla

 

[Haluk]

Noktalı virgüller arasında başka veriler var herhalde.... Bunların hepsi metin mi, yoksa nümerik olanlar da var mı? Tarih- Saat bilgileri var mı?

Örnek TXT dosyasını biraz daha geliştirseniz iyi olurdu...

.

 

[Haluk]

Bilinmezliklere rağmen size bir alternatif hazırladım.

Ekli sıkıştırılmış dosyanın içindekilerini topluca bir klasöre açın.

Text dosyasından veriler Excel'e; ADO yöntemi kullanılarak Schema dosyası yardımıyla alınacaktır.

.

 

[Tevfik_Kursun]

Sayın Haluk Hocam,
İlginize teşekkür ederim. Örnekler ekte.
Saygılarımla

 

[Haluk]

Dosyalarınız ektedir...

.

 

[assenucler]

Sayın Tevfik_Kursun,

Konuyu açtığınız için size;


Sayın Haluk,

Üstadım emek katkılarınız için de size çok teşekkür eder, her şey gönlünüzce olmasını dilerim.

Sevgi ve saygılar.

 

[Tevfik_Kursun]

Sayın Haluk Hocam,
Çok teşekkür ederim.
Saygılarımla

 

[Tevfik_Kursun]

Sayın Assenucler,
Rica ederim arkadaşım.
İyi çalışmalar

 

[Tevfik_Kursun]

Merhaba Sayın Haluk Hocam,
Hazırlanan makroda iki noktada dosya adı var. Aynı dosyayı farklı isimle verirseniz, sadece 1. sütuna alıp bekliyor. Ornek_1.txt te bunu gördüm.
Ornek_2.txt te ilk 4 sütundan sonraki sütunlarda 1. si tarih, 2. ifade. Ama aynı dosyada 6. ve sonraki sütunları almıyor, ya da 1. satırı A5 e yazıp duruyor.
Bütün bunlar neden olabilir?
Saygılarımla

 

[Haluk]

İlk önce VBA kodlarını ve Schema dosyalarını incelemelisiniz......

VBA kodlarında ve Schema dosyalarında verilerin alınacağı Text dosyalarının isimleri var ve bunları doğru girmek zorundasınız.

Kolay gelsin,

.

 

[Tevfik_Kursun]

Sayın Hocam,
Schema dosyası uyarınız için teşekkür ederim.
Ornek_2.txt de, satır sayısını azaltıp ilk satıra 4 tarih 4 ifade koyduğumda sorunsuz aldı. Ama aynı yere gerçek dosyayı belirtilen isimle olmasına rağmen 5. sütundan sonrasını almadı. F8 ile de kontrol ettim.
Satır sayısına bağlı bir durum var mı, onu da kendi kendime teyit edemedim.
Saygılarımla

 

[Haluk]

Satır sayısıyla ilgili bir durum yok.......

Söz konusu Text dosyanızın yapısı uygun olmayabilir belki, bilemiyorum..... Bana e-posta ile Text dosyanızı gönderirseniz, duruma bakabilirim.

.

 

[Haluk]

Tevfik Bey, e-posta ile gönderdiğiniz TEXT dosyasını inceledim.

Ekli Schema dosyasını kullanarak sorun çözülmüştür... Eskisini sildikten sonra, bunu kullanabilirsiniz.

Not: VBA kodlarında ve Schema dosyasında veri alınacak Text dosyası adı Ornek_2.txt olmalıdır.

.

 

[Tevfik_Kursun]

Merhaba Sayın Haluk Hocam,
İlginize çok teşekkür ederim. Bu sorun sanırım yazılı ifadelerin uzun olmasında. O dosya sadece 20 kolondan ibaret değil. 400 kolon olacak. Baştan .ini dosyasını her satır çift uzunluklu olacak şekilde gelecek demek çalışmaya sıkıntı verir mi acaba?
Saygılarımla

 

[Haluk]

Tevfik Bey esas sıkıntı; işin en başında yukarıda 2 No'lu mesajımda belirttiğim gibi sağlıklı bir örnek dosya vermemenizden kaynaklanıyor.

14.mesaja geldik ama siz halen, dosyadaki sütunların 20 değil 400 olacağından bahsediyorsunuz.

Ayrıca "çift uzunluk" ifadenizden neyi kastettiğinizi de anlamadım. Bu bahsettiğiniz ifadeyi Schema dosyasındaki "Double" için kullandıysanız, hiç ilgisi yok.... Text dosyasındaki verilere göre o sütunların "metin" değil de "nümerik" olduklarını gördüğüm için o şekilde bir biçimlendirme yapmıştım.

.

 

[halit3]

Alternatif kod buradaki kodlar bir klasörün içindeki text dosyalarını excele ceviriyor.

Dim msg1
Dim Klasor2
Sub txt_cevir()

Sayfa_adı = ActiveSheet.Name
Set Klasor = CreateObject("shell.application").browseforfolder(0, "Lütfen bir klasör seçiniz", 50, &H0)
If Not Klasor Is Nothing Then
Kaynak = Klasor.SELF.Path
If InStr(1, Kaynak, "{") > 0 Then GoTo atla
Application.ScreenUpdating = False
Application.DisplayAlerts = False

If Right(Kaynak, 1) <> "\" Then Kaynak = Kaynak & "\"

Klasor2 = ""
Klasor2 = Kaynak & "Excel Dosyaları"

If CreateObject("Scripting.FileSystemObject").FolderExists(Klasor2) = False Then
MkDir Klasor2
End If

 msg1 = MsgBox("Csv Dosyalarını" & Chr(10) & Chr(10) & _
 "silmek için  EVET tıklayınız. " & Chr(10) & Chr(10) & _
"silmemek için HAYIR tıklayınız.", vbYesNo + vbInformation, "u y a r ı !")

Liste2 (Klasor.Items.Item.Path)
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "işlem tamam"
Else
atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
Set Klasor = Nothing

End Sub


Private Sub Liste2(yol As String)
Dim fs As Object, f As Object
Set fs = CreateObject("Scripting.FileSystemObject")

uzanti = fs.GetExtensionName(ThisWorkbook.Name)

Dim wb As Workbook

For Each dosya In fs.getfolder(yol).Files
If ThisWorkbook.Name <> dosya.Name Then
If LCase(fs.GetExtensionName(dosya)) = "txt" Then


If uzanti = "xls" Then
FileFormatNum = -4143
uzanti2 = "xls"
ElseIf uzanti = "xlsm" Then
FileFormatNum = 51
uzanti2 = "xlsx"
ElseIf uzanti = "xlsx" Then
FileFormatNum = 51
uzanti2 = "xlsx"
End If

'Set wb = Workbooks.OpenXML(dosya)


Workbooks.OpenText Filename:=dosya, DataType:=xlDelimited, Tab:=True
        
Application.DisplayAlerts = False

Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True
Range("A2").Select

ActiveWorkbook.SaveAs Klasor2 & "\" & fs.GetBaseName(dosya) & "." & uzanti2, FileFormat:=FileFormatNum '6   '-4158 'xlText
ActiveWindow.Close
'wb.SaveAs ad & "\" & fs.GetBaseName(dosya) & "." & uzanti2, FileFormat:=FileFormatNum '6   '-4158 'xlText
'wb.Close False

If msg1 = vbYes Then
fs.DeleteFile dosya
End If

End If
End If
Next

On Error GoTo sonraki
For Each f In fs.getfolder(yol).subfolders
Liste2 (f.Path)
sonraki:
Next

Set fL = Nothing
End Sub

 

[Haluk]

Her neyse ..... konu tam olarak olumlu veya olumsuz olarak sonuçlanmadan Halit bey konuya bodoslama girdiğine göre, ben aradan çekiliyorum.

Kolay gelsin....

.

 

[Tevfik_Kursun]

İlginize çok teşekkür ederim Haluk Hocam,
Yardımlarınızı unutamam.
Saygılarımla

 

[Tevfik_Kursun]

Şimdi inceleyip size döneceğim Halit3 Hocam,
Saygılarımla

 

[Tevfik_Kursun]

Çok teşekkür ederim Halit3 Hocam,
Lamba gibi geliyor, ama ayrı bir dosyaya. Keşke kullanılacak dosyada istenilen satır sütundan itibaren olsa ya da geçici açılacak bir sayfaya gelse.
Nasıl bu hızla aldığınızın tekniğini anlamaya çalışacağım.
Saygılarımla