txt dosyasını alma

[burhancavus61]

txt dosyasını uygun ölçülerde almam gerek bu işlemi her ay yapıyorum.
ben dosyanın bulunduğu adresi hücreye yazmalıyım C:\belgelerim\burhan.txt dosyasını sütunlara uygun şekilde yazmalı. örnek txt dosyası ektedir.

 

[burhancavus61]

cevap yokmu

yardımlarınızı bekliyorum

 

[Selçuk1]

sn. burhancavuş,

makro kaydet yöntemi ile aşağıdaki kodlara ulaştım. işinizi görebilir sanıyorum. dener misiniz?

Sub txt()

    ChDir "C:\Belgelerim"
    Workbooks.OpenText Filename:= _
        "C:\Belgelerim\burhan.txt", Origin:=932, _
        StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(10 _
        , 1), Array(42, 1), Array(72, 1), Array(82, 1), Array(93, 1), Array(107, 1), Array(119, 1), _
        Array(137, 1), Array(157, 1), Array(174, 1), Array(193, 1)), TrailingMinusNumbers:= _
        True
    ActiveWindow.ScrollRow = 2
    ActiveWindow.ScrollRow = 3
End Sub

 

[burhancavus61]

bir sorun daha

sayın cellchuq txt dosyayı aldım ama bu seferde karakteri farklı aldı dosya kaynağını windows ansı olarak ve kendi kitabının içerisine nasıl alacağız.

 

[burhancavus61]

sorunumu halledebilecek yokmu

üstadlar yardım edin lütfen

 

[enteresan]

Sayın brhançavuş, cellchug isimli arkadaşımın yaptığı makroda origin=932 sayısını 1254 olarak değiştirirseniz sorununuz çözülecektir. Ayrıca ben acemice bir deneme yaptım ve aşağıdaki kodları elde ettim bir denemenezi tavsiye ederim....
Not: Nokta işareti olan yerlerde sizin dosyanın bulunduğu yol ismi yazılması gerekiyor. Orayı kendinize göre düzenlersiniz..... Saygılarımla....

Sub Makro2()
'
' Makro2 Makro
' Makro enteresan tarafından 07.01.2007 tarihinde kaydedildi.
'

'
Workbooks.OpenText Filename:= _
"C:\Documents and Settings\.......\Desktop\Yeni Klasör (3)\burhan.txt", Origin _
:=1254, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1) _
, Array(10, 1), Array(42, 1), Array(72, 1), Array(82, 1), Array(93, 1), Array(107, 1), Array _
(119, 1), Array(137, 1), Array(157, 1), Array(174, 1), Array(193, 1)), _
TrailingMinusNumbers:=True
Cells.Select
Cells.EntireColumn.AutoFit
Range("E29").Select
ActiveCell.FormulaR1C1 = "KOLAY GELSİNNNNN….."
Range("G28").Select
End Sub

 

[Haluk]

Bir makro da ben kaydettim;

Öncelikle bahsettiğiniz burhan.txt dosyasını masa üstüne yerleştirin, daha sonra aşağıdaki kodu çalıştırın.

Sub Macro1()
'
' Macro1 Macro
' Macro recorded 07.01.2007 by Raider
'

'
    Dim WshShell As Object
    Dim MyDesktopPath As String, MyFile As String
    Set WshShell = CreateObject("WScript.Shell")
    MyDesktopPath = WshShell.SpecialFolders("Desktop")
    MyFile = "[COLOR=Red][B]burhan.txt[/B][/COLOR]"
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & MyDesktopPath & Application.PathSeparator & MyFile, Destination:=Range("A1"))
        .Name = "burhan"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = xlWindows
        .TextFileStartRow = 1
        .TextFileParseType = xlFixedWidth
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)
        .TextFileFixedColumnWidths = Array(10, 32, 30, 10, 11, 14, 12, 18, 20, 17, 19)
        .TextFileDecimalSeparator = ","
        .TextFileThousandsSeparator = "."
        .Refresh BackgroundQuery:=False
    End With
    Range("A2") = 1
    Range("A2").Copy
    ActiveSheet.UsedRange.PasteSpecial Paste:=xlAll, Operation:=xlMultiply, SkipBlanks:=False, Transpose:=False
    Rows(2).Delete
    Range("E:L").NumberFormat = "0.00"
    x = ActiveSheet.UsedRange.Rows.Count
    Rows(x - 3 & ":" & x).Delete
    Range("A1").Select
    Rows(1).Font.Bold = True
    Set WshShell = Nothing
End Sub

 

[burhancavus61]

ellerinize sağlık

çok güzel olmuş arkadaşlar
ama haluk beyin yaptığı işimi gördü
teşekkürler