.txt den xls ye

[zaebolll]

Merhaba, yardımcı olabilecek olursa çok makbul geçer.

txt den excel e veri alırken, InStr ile buldurduğum satırın belli bir satır aşağısındaki verileri nasıl alabilirim.


ARANACAKLAR :
==============================
SA NAME NUMBER NUM
ABC17020 17120 17120
DSV17025 17025 17025
ASD35036 35036 35036
XCV35037 34444 34444
TTR35038 32222 32222

Mesela üstteki örneğe göre txt dosyasında;
If InStr(logLine, "ARANACAKLAR") Then
şeklinde buldurduğum satırın üç satır aşağısındaki ABC17020 ile başlayan kısmından itibaren excel e veri akışını istiyorum.
.Cells(R, 1).Value = Trim(Mid(..., 37, 8)) gibi..

 

[Zeki Gürsoy]

Örnek küçük. Bu dosyada başka başlıklar olacak mı?

ARANACAKLAR :
==============================

Ayraç olmaması işi zorlaştırabilir. Sayı ve kodların uzunluğu sabit mi?

 

[zaebolll]

Evet dosyada başka başlıklarda var,
Sayı ve kodların başlangıç ları sabit ama uzunluğu değişken olabiliyor.

 

[zaebolll]

Peki arkadaşlar ekteki ornek.txt nin ekteki ornek.xls de olacak şekilde txt den xls ye veri akışı düzenlemesini nasıl bir makro ile yapabiliriz.

isimler aynı olduğu için beceremedim. Yardımcı olabilir misiniz lütfen.

 

[zaebolll]

Bir üstteki yazı için şans var mıdır fikir beyan edebilir misiniz. Şimdiden teşekkürler.

 

[zaebolll]

Sorumun daha net anlaşılması için küçük bir makro hazırladım.

Anasayfa daki butonlar ile txt nin islem sayfasına yazdırılması esnasında, excel deki makro da değerlerin işlem sayfasına doğru aktarılabilmesi için yardımcı olunabilir mi lütfen.

 

[zaebolll]

Ümidi kesiyorum?

 

[usubaykan]

Ümidi kesiyorum?

Eki incelermisiniz. İstediğiniz gibi olmuşmu? Kullanılan kod;

Option Explicit
Sub Txt_den_Xls_ye()
Dim SR As Worksheet, SÖ As Worksheet, Bul As Range, Son As Long, Sütun As Byte
Dim Adres As String, Dosya_Yolu As String, Birleştir As String
Application.ScreenUpdating = False
Set SR = Sheets("Rapor")
Set SÖ = Sheets("Özet")
Dosya_Yolu = ThisWorkbook.Path
SR.Cells.ClearContents
SÖ.Cells.ClearContents
    With SR.QueryTables.Add(Connection:="TEXT;" & Dosya_Yolu & "\Örnek.txt", Destination:=SR.Range("A1"))
        .TextFilePlatform = 857
        .TextFileStartRow = 1
        .TextFileParseType = xlFixedWidth
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
        .TextFileFixedColumnWidths = Array(23, 5, 15, 4, 23)
        .Refresh BackgroundQuery:=False
    End With
    
    Set Bul = SR.Cells.Find(What:=":", LookAt:=xlPart)
    If Not Bul Is Nothing Then
    Adres = Bul.Address
        
        Son = SÖ.Range("A65536").End(3).Row
        Sütun = SÖ.Range("IV2").End(xlToLeft).Column
    Do
        If SR.Cells(Bul.Row, Bul.Column) = "DOC IP NEW BIS:" Then _
        Birleştir = SR.Cells(Bul.Row - 1, Bul.Column)
        
        SÖ.Cells(Son, Sütun) = SR.Cells(Bul.Row, Bul.Column) & "(" & Birleştir & ")"
        SÖ.Cells(Son + 1, Sütun) = SR.Cells(Bul.Row, Bul.Column + 1)
        Set Bul = SR.Cells.FindNext(Bul)
        Sütun = Sütun + 1
        
      
    Loop While Not Bul Is Nothing And Adres <> Bul.Address
    End If
    
    SÖ.Cells.Replace What:=":", Replacement:="", LookAt:=xlPart
    
    With SÖ.Range("A1:IV1")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .Orientation = 90
    End With
MsgBox "İşleminiz tamamlanmıştır.", vbInformation, "Sn: " & Application.UserName
Application.ScreenUpdating = True
End Sub

 

[zaebolll]

Ayırdığınız vakit ve paylaşımınız için çok teşekkür ederim.

Maalesef aslında ortada daha büyük ve çeşitli verilerden oluşan kaynak bir text dosyası var. Çok güzel düşünmüşsünüz lakin ana text dosyası belirttiğim gibi daha büyük ve sadece talep ettiğim verileri içermiyor, bir dünya farklı veriler de bulunmakta. Büyük kısmında belirli ayraçlar veya sabit isimler olduğundan bir önceki iletimde gönderdiğim makro şeklinde verileri rahatça işleyebiliyorum. Sadece talep ettiğim kısımda problem çıkıyor idi. Onuda bugün bazı döngüler ekleyerek çözdüm. Tekrardan teşekkürler.