Bir çok txt dosyasından excel'e veri almak

[uyeyimben]

Arkadaşlar öncelikle sorunuma yardımcı olabilsenizde olamasanızda bu sitede bilgi birikimini aktaran ve birçok soruya cevap veren herkese çok teşekkr ederim.

Yaptığım analizler sonucunda elimde 83540 adet *.txt dosyası bulunmaktadır. Bu dosyaların içinden sadece 1 değeri alıp excele yazdırmak istiyorum.

Bu işlemimi excel VBA ile nasıl yapabilirim.

Ekte Dosyalarımın bir kısmı bulunmaktadır.

bu dosyalarda bulunan

Friction mean/SD, dist, lower/upper/loc/scale  .  10 2 lognormal

Satırındaki 10, 12, 14 16 gibi her dosyada değişen değerleri almak istiyorum.

Yardımlarınızı bekliyorum.

 

[halit3]

Arkadaşlar öncelikle sorunuma yardımcı olabilsenizde olamasanızda bu sitede bilgi birikimini aktaran ve birçok soruya cevap veren herkese çok teşekkr ederim.

Yaptığım analizler sonucunda elimde 83540 adet *.txt dosyası bulunmaktadır. Bu dosyaların içinden sadece 1 değeri alıp excele yazdırmak istiyorum.

Bu işlemimi excel VBA ile nasıl yapabilirim.

Ekte Dosyalarımın bir kısmı bulunmaktadır.

bu dosyalarda bulunan

Friction mean/SD, dist, lower/upper/loc/scale  .  10 2 lognormal

Satırındaki 10, 12, 14 16 gibi her dosyada değişen değerleri almak istiyorum.

Yardımlarınızı bekliyorum.

Bu açıklamanızdan bir şeyler anlıyorum ama sorunuzu örnek bir excel dosyası ile destekleyin yani hangi text dosyasından veri alacaksanız excel tablosunda alacağınız verilere ait hücrelere manuel olarak yazınki ne şekilde olacağını bilelim.

Sonradan kodları revize etmekten kaçınalım.

 

[uyeyimben]

bu açıklamanızdan bir şeyler anlıyorum ama sorunuzu örnek bir excel dosyası ile destekleyin yani hangi text dosyasından veri alacaksanız excel tablosunda alacağınız verilere ait hücrelere manuel olarak yazınki ne şekilde olacağını bilelim.

Sonradan kodları revize etmekten kaçınalım.

Ekte gönderdiğim dosya içerisinde bulunan "DATA_OKU.xlsm" dosyasi içerisinde bulunan tabloya "SLOPE_INPUT_18_1.2_16_10.TXT" Dosyasında bulunan;

11. SATIRINDAKİ "1.2" DEĞERİNİ
15. SATIRINDAKİ "16" DEĞERİNİ
16. SATIRINDAKİ "10" DEĞERİNİ
18. SATIRINDAKİ "18" DEĞERİNİ

yazdırmak istiyorum.

ancak bu "slope_ınput_18_1.2_16_10.txt" dosyasından toplam 216 adet var. dosya isimleri belirli bir düzene göre değişmekte, bu dosyaları oluştururken kullandığım kodlama ;

Sub GIRDIDOSYALARI()

Dim k, m, n, p As Integer



        For k = 1 To 2 Step 0.2  'SEV EĞİMİ
        For m = 16 To 20 Step 2  'COHESSION DEGERI
        For n = 10 To 16 Step 2  'FRICTION ANGLE
        For p = 18 To 22 Step 2  'UNİTS WEİGHT

        
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        yol = "C:\analiz\SLOPE_INPUT_" & p & "_" & k & "_" & m & "_" & n & ".txt"  'Dosyanın kayıt edileceği yer
        
          Open yol For Output As #1
            satir = 34      'input dosyasındaki veri içeren satır sayısı
            sutun = 1       'input dosyasındaki veri içeren sütun sayısı
                For i = 1 To satir
                    For j = 1 To sutun
                        a = a & Cells(i, j) & " "
                        
                        
[A1] = "Stability of a 2:1 slope"
[A2] = "Echo input data to stats file (t/f)? . . . . . .  t"
[A3] = "Report progress to standard output (t/f)?. . . .  t"
[A4] = "Dump debug data to *.stt file (t/f)? . . . . . .  f"
[A5] = "Display a random field (t/f)?  . . . . . . . . .  f 1 c"
[A6] = "Display displaced FE mesh (t/f)? . . . . . . . .  f 1"
[A7] = "Number of x-elements to left of embankment . . .  20"
[A8] = "Number of x-elements to right of embankment  . .  20"
[A9] = "Number of y-elements in embankment . . . . . . .  10"
[A10] = "Number of y-elements in foundation . . . . . . .  5"
[A11] = "Slope gradient (x/y) . . . . . . . . . . . . . .  " & k 'kkkkkkkkkkkkkkkkk
[A12] = "Element size . . . . . . . . . . . . . . . . . .  0.05 0.05"
[A13] = "Convergence tolerance  . . . . . . . . . . . . .  0.0001"
[A14] = "Maximum number of iterations . . . . . . . . . .  " & [H14]
[A15] = "Cohesion mean, SD, dist  . . . . . . . . . . . .  " & m & " 2 lognormal" 'mmmmmmmmmmmm
[A16] = "Friction mean/SD, dist, lower/upper/loc/scale  .  " & n & " 2 lognormal" 'nnnnnnn
[A17] = "Dilation angle mean, SD, dist  . . . . . . . . .  0 0 deterministic"
[A18] = "Unit weight mean, SD, dist . . . . . . . . . . .  " & p & " 2 lognormal"  'pppppppppppp
[A19] = "Elastic modulus mean, SD, dist . . . . . . . . .  100000 50000 lognormal"
[A20] = "Poisson 's ratio mean, SD, dist . . . . . . . . . 0.3 0 deterministic"
[A21] = "Deterministic strength reduction factors . . . .  1 1.1 1.2 1.3 1.4 1.5 2 2.5 3"
[A22] = "Number of realizations . . . . . . . . . . . . .  200"
[A23] = "Generator seed (0 for random seed) . . . . . . .  0"
[A24] = "Correlation length in X [and Y] directions . . .  1 1"
[A25] = "Name of covariance function  . . . . . . . . . .  dlavx2"
[A26] = ""
[A27] = "Material Property Correlation Matrix Data"
[A28] = "                                       "
[A29] = "Property 1    Property 2    Correlation"
[A30] = "----------    ----------    -----------"
[A31] = ""
[A32] = "Show element boundaries  . . . . . . . . . . . .  t"
[A33] = "Show random field as background [log?] [prop?] .  t t c"
[A34] = "Width of displaced mesh output plot in inches  .  4"
                            
                    Next j
                Print #1, Left(a, Len(a) - 1)
                a = ""
                Next i
          Close #1
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        
        Next p
        Next n
        Next m
        Next k
 
 End Sub

burada dosya isimlendirmeleri değişken isimlerine bağlı olarak değiştmekte. " p k m n" değişkenlerine bağlı olarak "C:\analiz\SLOPE_INPUT_" & p & "_" & k & "_" & m & "_" & n & ".txt" dosyaları oluşturulmuştur.

Benim yapmak istediğim bu oluşturulan dosyalardan istediğim değerlei tekrardan excel de tablo olarak görebilmek.



(not: bu *.txt dosyalatnı oluşturduğum excel dosyası da ekteki klasördedir. bu textdosyaları birbirinin aynısı gibi gözüksede her birinde bir tane rakam değiştirilmiştir.)

uzun yazmış olmama rağmen konuyu bilen biri için kolay olabileceğini düşünüyorum ama şuan benim için çok fazla zor bu işlemi yapmak. İlgilendiğin için şimdiden teşekkür ederim.

 

[halit3]

Bu kodu denermisiniz ?

Sub Dosya_Yolu()
Dim Klasor As Object
Set Klasor = CreateObject("Shell.Application").BrowseForFolder(0, "Lütfen bir klasor seçin !", 1)
If Not Klasor Is Nothing Then
If InStr(1, Klasor, "{") > 0 Then GoTo Atla
Liste (Klasor.SELF.Path)
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 Liste(Yol As String)
Dim fL As Object, f As Object
Set fL = CreateObject("Scripting.FileSystemObject").GetFolder(Yol).SubFolders
For Each dosya In CreateObject("Scripting.FileSystemObject").GetFolder(Yol).Files
i = Cells(Rows.Count, "b").End(3).Row + 1
Open dosya For Input As #1
Do While Not EOF(1)
Line Input #1, a
If Mid(a, 1, 50) = "Slope gradient (x/y) . . . . . . . . . . . . . .  " Then
Cells(i, 2).Value = Mid(a, 51, 3)
ElseIf Mid(a, 1, 50) = "Cohesion mean, SD, dist  . . . . . . . . . . . .  " Then
Cells(i, 3).Value = Mid(a, 51, 3)
ElseIf Mid(a, 1, 50) = "Friction mean/SD, dist, lower/upper/loc/scale  .  " Then
Cells(i, 4).Value = Mid(a, 51, 3)
ElseIf Mid(a, 1, 50) = "Unit weight mean, SD, dist . . . . . . . . . . .  " Then
Cells(i, 5).Value = Mid(a, 51, 3)
End If
Loop
Close
Next
On Error GoTo sonraki
For Each f In fL
Liste (f.Path)
sonraki:
Next
Application.DisplayAlerts = True
Set fL = Nothing
End Sub

 

[uyeyimben]

Gerçekten tam istediğim işlem. Çok teşekkür ediyorum. Benimde size yardım edebileceğim bir konu var ise elimden geldiği kadar yardım edebilirim. (İnşaat Mühendisiyim)