Text dosyasından veri almak-4

[k0081]

Günaydın arkadaşlar;

Eklemiş olduğum Liste01.txt de ki , örnek tabloda açıkladığım biçimde nasıl veri alabilirim.

Ekli dosyayı görüntüle yedek.xlsm
Ekli dosyayı görüntüle Liste02.txt

yardımcı arkadaşa şimdiden teşekkürler. Herkese Kolay gelsin.

 

[omerceri]

Aşağıdaki gibi bir kodla aynı klasördeki txt dosyasını excel de geçici olarak oluşturulan sayfaya aktarıp içindeki bilgilerin gerekli olanlarını alıp daha sonra bu sayfa silinebilir.
Açık olarak anladığım "31507,7" sayısı yazılı olan hücreyi Rapor sayfasındaki G33 hücresine aktarıyor.
Ama diğer verileri anlamadım.
CC200-3-30-60 yazan satırlar sabit mi? değişebiliyor mu?
6460
6460
6460
6339
6339
3014
3014
3012
3012
2912
2912
2910
2910
2899
2898
6460
2899
6460
2899
2898
verilerinin bulunduğu sütunda 3 değil 5 tane 6460 sayısı var niye 3 tanesini alıyoruz.
Benim anlamadığım konularda, KOLON sayfasındaki listeyi olması gereken verilerle örneklendirirseniz. Kodlarda eksiklikleri tamamlayabilirim

Sub Makro1()
     Sheets.Add
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & ThisWorkbook.Path & "\Liste02.txt", Destination:=Range("A1"))
        .Name = "Liste02"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 932
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = True
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = True
        .TextFileColumnDataTypes = Array(9, 1, 1, 1, 1, 1, 1)
        .TextFileDecimalSeparator = "."
        .TextFileThousandsSeparator = ","
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
   Sheets("RAPOR").Range("G33").Value = Columns("A:A").Find(What:="Total:").Offset(0, 1)
   Application.DisplayAlerts = False
    ActiveWindow.SelectedSheets.Delete
End Sub

 

[k0081]

Ama diğer verileri anlamadım.
CC200-3-30-60 yazan satırlar sabit mi? değişebiliyor mu?
verilerinin bulunduğu sütunda 3 değil 5 tane 6460 sayısı var niye 3 tanesini alıyoruz.Benim anlamadığım konularda, KOLON sayfasındaki listeyi olması gereken verilerle örneklendirirseniz. Kodlarda eksiklikleri tamamlayabilirim

1- CC200-3-30-60 Bu satırlar sabit değil hocam. sayılar değişebilir. harflerde.. bunlar malzeme isimleri.. (liste02.txt de size yazan sütun..)

2- 6460 sadece bir örnek uzunluk. ve adedi 3 Rapordaki sistem böyle olduğu için.. hocam.

liste şu şekide olmalı hocam.

 

[omerceri]

Bütün Malzemeleri aktarıyor. Malzeme satırlarını diğer satırlardan ayırmak için CONTRACT sütununu sayısal olma ve boş olmama testi uygulayarak elde ettim.

Sub Makro1()
Application.ScreenUpdating = False
 Sheets("KOLON").Range("B19:E65536").ClearContents
     Sheets.Add
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & ThisWorkbook.Path & "\Liste02.txt", Destination:=Range("A1"))
        .Name = "Liste02"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 932
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = True
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = True
        .TextFileColumnDataTypes = Array(9, 1, 1, 1, 1, 1, 1)
        .TextFileDecimalSeparator = "."
        .TextFileThousandsSeparator = ","
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    say = Range("A65536").End(3).Row
    For i = 1 To say
    If IsNumeric(Range("F" & i)) And Range("F" & i) <> "" Then
    say1 = Sheets("KOLON").Range("B65536").End(3).Row + 1
    Sheets("KOLON").Range("B" & say1).Value = Range("A" & i)
    Sheets("KOLON").Range("D" & say1).Value = Range("D" & i)
    Sheets("KOLON").Range("E" & say1).Value = Range("C" & i)
    End If
    Next
   Sheets("RAPOR").Range("G33").Value = Columns("A:A").Find(What:="Total:").Offset(0, 1)
   Application.DisplayAlerts = False
    ActiveWindow.SelectedSheets.Delete
    Application.ScreenUpdating = False
End Sub

 

[k0081]

omerceri;

hocam bu hatayı alıyorum..

 

[omerceri]

Hem 2003 hemde 2007 yüklü PC lerde denedim çalışıyor. Bu çalışan örneği ekliyorum. txt dosyası ile aynı klasörde olmalı

 

[k0081]

Sn Ömerceri ;

Çok teşekkür ederim tamamdır.. Macro ile doğrudan çalışıyor.. ben kodları butona eklediğim için hata alıyormuşum.. Saygılar sunuyorum.. (Ofis 2010)