• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Excelde Text Dosyasından Veri Çekmek

N

noctherion

Katılım
15 Kasım 2011
Mesajlar
21
Excel Vers. ve Dili
2007 - İngilizce
Selamlar,

Benim bir text dosyasından veri çekmek ile ilgili bir sorum olacak. Text dosyasından belirli satırdaki verileri çekmek için aşağıdaki kodu kullanıyorum.
Kod: 
Sub test_1()
    Dim jess916 As Variant, FullPath As String
    Set jess916 = Application.FileDialog(msoFileDialogFilePicker)
    With jess916
        .InitialView = msoFileDialogViewDetails
        .InitialFileName = ThisWorkbook.Path
        .Filters.Add "Open File ", "*.txt", 1
        .ButtonName = "Import file"
        .Title = " jess916c Search for .txt file to Import"
        If .Show = -1 Then
            FullPath = .SelectedItems(1)
Else:
            Exit Sub
        End If
    End With
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & FullPath, Destination:=Range("A5"))
         .Name = "textfile"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 857
        [COLOR="Red"].TextFileStartRow = 23[/COLOR]
        .TextFileParseType = xlFixedWidth
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(9, 2, 9, 9)
        .TextFileFixedColumnWidths = Array(7, 14, 47)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Columns("A:A").ColumnWidth = 12
   
    Range("A1").Select
    Columns("A:A").Select
    Selection.Replace What:=".", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
End Sub

Benim excelde uygulamam şu şekilde; Butona basılınca, text dosyasını seçeceğim pencere açılıyor. Kod olarak sıkıntı yok. Ancak
.TextFileStartRow = 23
Genişletmek için tıkla ...
burada çekilecek verinin satır numarası sürekli değişiyor. Örnek bir text dosyasını ekte yolluyorum. Çekilecek verilerin satır numarası her zaman ekte verdiğim text dosyasında da geçen " Secondary" kelimesinden sonraki satır oluyor.

Ben, text dosyası içerisinde "Secondary" kelimesinin bulunduğu satır numarasını bulup, bundan bir sonraki satır numarasını
.TextFileStartRow = 23
Genişletmek için tıkla ...
buraya yazdırmak istiyorum. Bu konuda yardımcı olursanız çok sevinirim. Teşekkürşler...
 

Ekli dosyalar

Merhaba,
Aşağıdaki kodu, kod sayfanızın en üstüne yapıştırdıktan sonra yukarıda kırmızı ile belirttiğiniz satırdaki 23 sayısının yerine Satir (i harfi ı değil) sözcüğünü yazıp dener misiniz?
Kod: 
Dim Satir As Integer

Sub SatırBul()
i = 0
Open ThisWorkbook.Path & "\textfile.txt" For Input As #1
Do While Not EOF(1)
    Line Input #1, Data1
    i = i + 1
If Left(Data1, 10) = " Secondary" Then
    Satir = i + 1
    GoTo AtlaGit
End If
Loop
AtlaGit:
    Close #1
test_1
End Sub
 
noctherion' Alıntı:
Selamlar,

Benim bir text dosyasından veri çekmek ile ilgili bir sorum olacak. Text dosyasından belirli satırdaki verileri çekmek için aşağıdaki kodu kullanıyorum.
Kod: 
Sub test_1()
    Dim jess916 As Variant, FullPath As String
    Set jess916 = Application.FileDialog(msoFileDialogFilePicker)
    With jess916
        .InitialView = msoFileDialogViewDetails
        .InitialFileName = ThisWorkbook.Path
        .Filters.Add "Open File ", "*.txt", 1
        .ButtonName = "Import file"
        .Title = " jess916c Search for .txt file to Import"
        If .Show = -1 Then
            FullPath = .SelectedItems(1)
Else:
            Exit Sub
        End If
    End With
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & FullPath, Destination:=Range("A5"))
         .Name = "textfile"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 857
        [COLOR=red].TextFileStartRow = 23[/COLOR]
        .TextFileParseType = xlFixedWidth
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(9, 2, 9, 9)
        .TextFileFixedColumnWidths = Array(7, 14, 47)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Columns("A:A").ColumnWidth = 12
 
    Range("A1").Select
    Columns("A:A").Select
    Selection.Replace What:=".", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
End Sub

Benim excelde uygulamam şu şekilde; Butona basılınca, text dosyasını seçeceğim pencere açılıyor. Kod olarak sıkıntı yok. Ancak burada çekilecek verinin satır numarası sürekli değişiyor. Örnek bir text dosyasını ekte yolluyorum. Çekilecek verilerin satır numarası her zaman ekte verdiğim text dosyasında da geçen " Secondary" kelimesinden sonraki satır oluyor.

Ben, text dosyası içerisinde "Secondary" kelimesinin bulunduğu satır numarasını bulup, bundan bir sonraki satır numarasını buraya yazdırmak istiyorum. Bu konuda yardımcı olursanız çok sevinirim. Teşekkürşler...
Genişletmek için tıkla ...

Alternatif kod:

Kod: 
Dim [COLOR=red]satir[/COLOR]
Sub oku()
Dim vFile As Variant
vFile = Application.GetOpenFilename("Text Files (*.txt*)," & "*.txt*", 1, "Text Dasyasını Aç", "Open", False)
If TypeName(vFile) = "Boolean" Then
Exit Sub
End If
satir = 0
i = 1
Open Dir(vFile) For Input As #1
Do While Not EOF(1)
Line Input #1, a
If Trim(a) = "Secondary" Then
[COLOR=red]satir[/COLOR] = i + 2
End If
i = i + 1
Loop
Close
MsgBox satir
test_1
End Sub
 
 

Sub test_1()
    Dim jess916 As Variant, FullPath As String
    Set jess916 = Application.FileDialog(msoFileDialogFilePicker)
    With jess916
        .InitialView = msoFileDialogViewDetails
        .InitialFileName = ThisWorkbook.Path
        .Filters.Add "Open File ", "*.txt", 1
        .ButtonName = "Import file"
        .Title = " jess916c Search for .txt file to Import"
        If .Show = -1 Then
            FullPath = .SelectedItems(1)
Else:
            Exit Sub
        End If
    End With
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & FullPath, Destination:=Range("A5"))
         .Name = "textfile"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 857
        .TextFileStartRow =[COLOR=red] satir
[/COLOR]        .TextFileParseType = xlFixedWidth
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(9, 2, 9, 9)
        .TextFileFixedColumnWidths = Array(7, 14, 47)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Columns("A:A").ColumnWidth = 12
   
    Range("A1").Select
    Columns("A:A").Select
    Selection.Replace What:=".", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
End Sub
 
Buda farklı kod:

Kod: 
Option Explicit

Sub oku()
Dim vFile As Variant
Dim Dosya, Veri, deg, k, satir, i, s, a
vFile = Application.GetOpenFilename("Text Files (*.txt*)," & "*.txt*", 1, "Text Dasyasını Aç", "Open", False)
If TypeName(vFile) = "Boolean" Then
Exit Sub
End If
k = 4
satir = 0
i = 1
Open Dir(vFile) For Input As #1
Do While Not EOF(1)
Line Input #1, a
If Trim(a) = "Secondary" Then
satir = 1
End If
If satir = 1 Then
k = k + 1
s = s + 1
If s > 1 Then
deg = Replace(Replace(Replace(WorksheetFunction.Trim(a), Chr(13), ""), Chr(9), ""), "-", "")
Veri = Split(deg, " ")
On Error Resume Next
Cells(k, 1).Value = Veri(1)
End If
End If
i = i + 1
Loop
Close
End Sub
 
Merhaba, öncelikle Halit ve Dede ikinizede çok teşekkür ederim. Verilen kodların üçünüde denedim. Üç kodda da "Run Time error 1004 : Application-defined or object defined error" hatası verdi. Debug dediğimde de ".TextFileStartRow = satir" bu satır sarıya boyalı şekilde gözüküyor. Yardımlarınızı bekliyorum.

Saygılar

Düzeltme : Excel 2007 kullanıyorum
 
Hazırladığım excel dosyasını ve örnek 2 text dosyasını ekte yolladım. Excel dosyası textfile.txt için çalışırken, textfile2.txt dosyası için çekmek istediklerim farklı satırda olduğundan düzgün çalışmıyor. Yukarda verdiğiniz kodlarıda denediğimde hata veriyor.
 

Ekli dosyalar

noctherion' Alıntı:
Merhaba, öncelikle Halit ve Dede ikinizede çok teşekkür ederim. Verilen kodların üçünüde denedim. Üç kodda da "Run Time error 1004 : Application-defined or object defined error" hatası verdi. Debug dediğimde de ".TextFileStartRow = satir" bu satır sarıya boyalı şekilde gözüküyor. Yardımlarınızı bekliyorum.

Saygılar

Düzeltme : Excel 2007 kullanıyorum
Genişletmek için tıkla ...

Kodunuzu yeniden derledim.

Kod: 
Private Sub CommandButton3_Click()
Dim vFile As Variant
Dim Dosya, Veri, deg, k, satir, i, s, a
vFile = Application.GetOpenFilename("Text Files (*.txt*)," & "*.txt*", 1, "Text Dasyasını Aç", "Open", False)
If TypeName(vFile) = "Boolean" Then
Exit Sub
End If
k = 5
satir = 0
i = 1
Open Dir(vFile) For Input As #1
Do While Not EOF(1)
Line Input #1, a
If Trim(a) = "Secondary" Then
satir = 1
End If
If satir = 1 Then
s = s + 1
If s > 1 Then
deg = Replace(Replace(Replace(WorksheetFunction.Trim(a), Chr(13), ""), Chr(9), ""), "-", "")
Veri = Split(deg, " ")
On Error Resume Next
If IsNumeric(Mid(Veri(2), 1, 1)) = False Then
Cells(k, 1).Value = Veri(1) & " " & Veri(2)
Else
Cells(k, 1).Value = Veri(1)
End If
k = k + 1
End If
End If
i = i + 1
Loop
Close
End Sub
Private Sub CommandButton4_Click()
Dim vFile As Variant
Dim Dosya, Veri, deg, k, satir, i, s, a
vFile = Application.GetOpenFilename("Text Files (*.txt*)," & "*.txt*", 1, "Text Dasyasını Aç", "Open", False)
If TypeName(vFile) = "Boolean" Then
Exit Sub
End If
k = 5
satir = 0
i = 1
Open Dir(vFile) For Input As #1
Do While Not EOF(1)
Line Input #1, a
If Trim(a) = "Secondary" Then
satir = 1
End If
If satir = 1 Then
s = s + 1
If s > 1 Then
deg = Replace(Replace(Replace(WorksheetFunction.Trim(a), Chr(13), ""), Chr(9), ""), "-", "")
Veri = Split(deg, " ")
On Error Resume Next
If IsNumeric(Mid(Veri(2), 1, 1)) = True Then
Cells(k, 2).Value = Veri(2)
Else
Cells(k, 2).Value = Veri(3)
End If
k = k + 1
End If
End If
i = i + 1
Loop
Close
End Sub
 

Ekli dosyalar

Teşekkür ederim Halit Bey. İstediğimden de iyi olmuş.

Saygılar...
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst