Excel'den txt dosyasının istenilen kısmına veri aktarma

castoridae · 29 Eylül 2016

Tüm forumdaşlara öncelikli olarak merhabalar.
Elimde bulunan bir txt dosyası içerisinde bol miktarda veri mevcut. Ben bu txt dosyası içersinden istediğim kısımları excel sütünlarına aktarıp istediğim düzenlemeleri yapabiliyorum. Ancak düzeltilmiş veriyi geri yazdırmak istediğimde txt dosyasında kalan her şey siliniyor, sadece excel kolonlarında yer alan bilgileri kaydediyor. Örneklemem gerekirse;
Elimdeki txt dosayası şu şekilde

Kod:

* 
* Satır_1
* 
$Arac:NO;NAME;DEP;LINENAME;LINEROUTENAME;DIRECTIONCODE;TIMEPROFILENAME;FROMTPROFITEMINDEX;TOTPROFITEMINDEX;OPERATORNO;ADDVAL1;ADDVAL2;ADDVAL3;SERVTRIPPATNO
1;O1;06:20:00;Arac_01;O01;>;1;1;57;1;0;0;0;0
2;O1;06:32:00;Arac_01;O01;>;1;1;57;1;0;0;0;0
3;O1;06:44:00;Arac_01;O01;>;1;1;57;1;0;0;0;0
4;O1;06:56:00;Arac_01;O01;>;1;1;57;1;0;0;0;0
5;O1;07:08:00;Arac_01;O01;>;1;1;57;1;0;0;0;0
6;O1;07:20:00;Arac_01;O01;>;1;1;57;1;0;0;0;0
7;O1;07:32:00;Arac_01;O01;>;1;1;57;1;0;0;0;0
8;O1;07:44:00;Arac_01;O01;>;1;1;57;1;0;0;0;0
9;O1;07:56:00;Arac_01;O01;>;1;1;57;1;0;0;0;0
* 
* Satır_2
* 
$Arac:NO;NAME;DEP;LINENAME;LINEROUTENAME;DIRECTIONCODE;TIMEPROFILENAME;FROMTPROFITEMINDEX;TOTPROFITEMINDEX;OPERATORNO;ADDVAL1;ADDVAL2;ADDVAL3;SERVTRIPPATNO
1;O1;06:20:00;Arac_02;O01;>;1;1;57;1;0;0;0;0
2;O1;06:32:00;Arac_02;O01;>;1;1;57;1;0;0;0;0
3;O1;06:44:00;Arac_02;O01;>;1;1;57;1;0;0;0;0
4;O1;06:56:00;Arac_02;O01;>;1;1;57;1;0;0;0;0
5;O1;07:08:00;Arac_02;O01;>;1;1;57;1;0;0;0;0
6;O1;07:20:00;Arac_02;O01;>;1;1;57;1;0;0;0;0
7;O1;07:32:00;Arac_02;O01;>;1;1;57;1;0;0;0;0
8;O1;07:44:00;Arac_02;O01;>;1;1;57;1;0;0;0;0
9;O1;07:56:00;Arac_02;O01;>;1;1;57;1;0;0;0;0
*
* Satır_3
* 
$Arac:NO;NAME;DEP;LINENAME;LINEROUTENAME;DIRECTIONCODE;TIMEPROFILENAME;FROMTPROFITEMINDEX;TOTPROFITEMINDEX;OPERATORNO;ADDVAL1;ADDVAL2;ADDVAL3;SERVTRIPPATNO
1;O1;06:20:00;Arac_03;O01;>;1;1;57;1;0;0;0;0
2;O1;06:32:00;Arac_03;O01;>;1;1;57;1;0;0;0;0
3;O1;06:44:00;Arac_03;O01;>;1;1;57;1;0;0;0;0
4;O1;06:56:00;Arac_03;O01;>;1;1;57;1;0;0;0;0
5;O1;07:08:00;Arac_03;O01;>;1;1;57;1;0;0;0;0
6;O1;07:20:00;Arac_03;O01;>;1;1;57;1;0;0;0;0
7;O1;07:32:00;Arac_03;O01;>;1;1;57;1;0;0;0;0
8;O1;07:44:00;Arac_03;O01;>;1;1;57;1;0;0;0;0
9;O1;07:56:00;Arac_02;O01;>;1;1;57;1;0;0;0;0

Ben excel kolonlarına. Satır_2 Altında yer alan Şu bilgileri alıyorum

Kod:

DEP	LINENAME	LINEROUTENAME
06:20:00	Arac_02	O01
06:32:00	Arac_02	O01
06:44:00	Arac_02	O01
06:56:00	Arac_02	O01
07:08:00	Arac_02	O01
07:20:00	Arac_02	O01
07:32:00	Arac_02	O01
07:44:00	Arac_02	O01
07:56:00	Arac_02	O01

Ve şu şekilde düzenliyorum;

Kod:

DEP	LINENAME	LINEROUTENAME
08:20:00	Arac_02	O02
08:32:00	Arac_02	O02
08:44:00	Arac_02	O02
08:56:00	Arac_02	O02
09:08:00	Arac_02	O02
09:20:00	Arac_02	O02
09:32:00	Arac_02	O02
09:44:00	Arac_02	O02
09:56:00	Arac_02	O02

Hazırladığım kod ile ilk veri alışı yaptığım txt. dosyası içine ve Satır_2 altına bu yeni veriyi yerleştirsin ve şu txt dosyasını kaydetmek istiyorum.

Kod:

* 
* Satır_1
* 
$Arac:NO;NAME;DEP;LINENAME;LINEROUTENAME;DIRECTIONCODE;TIMEPROFILENAME;FROMTPROFITEMINDEX;TOTPROFITEMINDEX;OPERATORNO;ADDVAL1;ADDVAL2;ADDVAL3;SERVTRIPPATNO
1;O1;06:20:00;Arac_01;O01;>;1;1;57;1;0;0;0;0
2;O1;06:32:00;Arac_01;O01;>;1;1;57;1;0;0;0;0
3;O1;06:44:00;Arac_01;O01;>;1;1;57;1;0;0;0;0
4;O1;06:56:00;Arac_01;O01;>;1;1;57;1;0;0;0;0
5;O1;07:08:00;Arac_01;O01;>;1;1;57;1;0;0;0;0
6;O1;07:20:00;Arac_01;O01;>;1;1;57;1;0;0;0;0
7;O1;07:32:00;Arac_01;O01;>;1;1;57;1;0;0;0;0
8;O1;07:44:00;Arac_01;O01;>;1;1;57;1;0;0;0;0
9;O1;07:56:00;Arac_01;O01;>;1;1;57;1;0;0;0;0
* 
* Satır_2
* 
$Arac:NO;NAME;DEP;LINENAME;LINEROUTENAME;DIRECTIONCODE;TIMEPROFILENAME;FROMTPROFITEMINDEX;TOTPROFITEMINDEX;OPERATORNO;ADDVAL1;ADDVAL2;ADDVAL3;SERVTRIPPATNO
1;O1;08:20:00;Arac_02;O02;>;1;1;57;1;0;0;0;0
2;O1;08:32:00;Arac_02;O02;>;1;1;57;1;0;0;0;0
3;O1;08:44:00;Arac_02;O02;>;1;1;57;1;0;0;0;0
4;O1;08:56:00;Arac_02;O02;>;1;1;57;1;0;0;0;0
5;O1;09:08:00;Arac_02;O02;>;1;1;57;1;0;0;0;0
6;O1;09:20:00;Arac_02;O02;>;1;1;57;1;0;0;0;0
7;O1;09:32:00;Arac_02;O02;>;1;1;57;1;0;0;0;0
8;O1;09:44:00;Arac_02;O02;>;1;1;57;1;0;0;0;0
9;O1;09:56:00;Arac_02;O02;>;1;1;57;1;0;0;0;0
*
* Satır_3
* 
$Arac:NO;NAME;DEP;LINENAME;LINEROUTENAME;DIRECTIONCODE;TIMEPROFILENAME;FROMTPROFITEMINDEX;TOTPROFITEMINDEX;OPERATORNO;ADDVAL1;ADDVAL2;ADDVAL3;SERVTRIPPATNO
1;O1;06:20:00;Arac_03;O01;>;1;1;57;1;0;0;0;0
2;O1;06:32:00;Arac_03;O01;>;1;1;57;1;0;0;0;0
3;O1;06:44:00;Arac_03;O01;>;1;1;57;1;0;0;0;0
4;O1;06:56:00;Arac_03;O01;>;1;1;57;1;0;0;0;0
5;O1;07:08:00;Arac_03;O01;>;1;1;57;1;0;0;0;0
6;O1;07:20:00;Arac_03;O01;>;1;1;57;1;0;0;0;0
7;O1;07:32:00;Arac_03;O01;>;1;1;57;1;0;0;0;0
8;O1;07:44:00;Arac_03;O01;>;1;1;57;1;0;0;0;0
9;O1;07:56:00;Arac_02;O01;>;1;1;57;1;0;0;0;0

Ancak ne yaptıysam geriye kalan veriyi korumayı başaramıyorum. Yanlızca excel sütununa attığım 3 kolon yazdırılıyor excel'e. Yardımcı olabilecek kimse var mı acaba?

TEGCreative · 29 Eylül 2016

Merhaba Sayın Castoridae ; Sayın Halit3'ün bu konuda vermiş olduğu bir başka cevaptır.

http://www.excel.web.tr/f48/kapaly-txt-dosyasyna-veri-ekleme-ve-silme-t110112/post599215.html

castoridae · 29 Eylül 2016

TEGCreative' Alıntı:
Merhaba Sayın Castoridae ; Sayın Halit3'ün bu konuda vermiş olduğu bir başka cevaptır.

http://www.excel.web.tr/f48/kapaly-txt-dosyasyna-veri-ekleme-ve-silme-t110112/post599215.html

Desteğiniz için teşekkürler, çok makbule geçti.

halit3 · 29 Eylül 2016

castoridae' Alıntı:
Desteğiniz için teşekkürler, çok makbule geçti.

http://s9.dosya.tc/server/hmuixy/Yeni_Klasor.rar.html

excele verileri aldığınız kodu da ekleyin buraya ne işlem yapıyor bir bakalım

castoridae · 2 Ekim 2016

halit3' Alıntı:
http://s9.dosya.tc/server/hmuixy/Yeni_Klasor.rar.html

excele verileri aldığınız kodu da ekleyin buraya ne işlem yapıyor bir bakalım

Sayın Özdemir,
İş nedeniyle cuma gününden beri yollardayım, kusura bakmayın dönemedim hemen. Yarın ofise geçince ilk fırsatta ekleyeceğim kodu, Zaman ayırdığınız için teşekkürler.

castoridae · 4 Ekim 2016

Tekrardan merhabalar. Hazırladığım kod aşağıdaki gibi ve verdiğim linkte de çalışması gereken txt dosyası ile birlikte mevcut. Yukarıyı okuyunca biraz karışık anlatmışım, biraz daha rahat anlaşılması açısından şöyle diyeyim. Aynı anda bir text dosyasına hem okuma hemde yazdırma yapmak istiyorum. Okuma yaparak istedeğim satırı bulma, ilgili satır bulununca da excel hücrelerinden aktarım yapmak istiyorum. Output komutu ile arama yaptıramadım, input komutu açık iken dosya üzerine veri yazdırmak mümkün olmuyor. Read write ve input komutlarnı bir arada kullanınca da sonuca ulaşamadım. Siz değerli üstatlar bu koda ne gibi bir ilave yada eksiltme yapmam gerektiği konusunda yardımcı olurlarsa çok memnun olurum.
https://upterabit.com/4ku/excelwebtr.rar

Kod:

Sub excelwebtr()
i = 1
say = 0
ciktilar = Cells(9, 6).Value

Baslangic_Satiri = "* Satır_2"
Bitis_Satiri = "* Satır_3"

Open ciktilar For Binary Access Read Write As #1

Do While Not EOF(1)
Line Input #1, deg1

If Trim(deg1) = Baslangic_Satiri Then
say = 1
End If

If say = 1 Then
If Trim(deg1) = Bitis_Satiri Then GoTo atla
i = i + 1

deg2 = Split(Trim(deg1), ";")

deg2(2) = Cells(1 + i, 1)
deg2(3) = Cells(1 + i, 2)
deg2(4) = Cells(1 + i, 3)
Write #1, deg2(2); ";"; deg2(3); ";"; deg2(4); ";"
End If

Loop
atla:
Close #1
End Sub

halit3 · 4 Ekim 2016

T1 hücresine düzeltilecek dosyanın adresini yaz.
T2 hücresine çıktı alınacak dosya adresini yaz.

bir modül oluştuır ve en üste bu verileri yapıştır.

Kod:

Const aranan_durak = [COLOR="Red"]"* Satır_2"[/COLOR]
Const aranan_saat1 = [COLOR="red"]"06:20:00"[/COLOR]
Const aranan_saat2 = [COLOR="red"]"06:50:00"[/COLOR]

kırmızı yerleri kendin değiştireceksin.

sonra hemen bu verilerin altına bu kodu kopyala yapıştır.

Kod:

Sub verial()

'Columns("A:A").ClearContents
ZBasla = TimeValue(Now)

Range("A2:Q500").ClearContents
  
dosya = Cells(1, 20).Value

sat = 1
Application.ScreenUpdating = False
sat = 2
say = 0
say2 = 0

'On Error Resume Next
Open dosya For Input As #1
 
Do While Not EOF(1)
Line Input #1, deg1

If deg1 = aranan_durak Then
say = 1
End If

If say = 1 Then

If Mid(Trim(deg1), 1, 1) = "*" Then
say2 = say2 + 1

If say2 = 2 Then
GoTo atla
End If
End If

If Mid(deg1, 1, 1) = "$" Then GoTo atla1

deg2 = Split(Trim(deg1), ";")
If UBound(deg2) > 0 Then
'MsgBox CDate(deg2(2)) & Chr(10) & CDate(aranan_saat1)
If CDate(aranan_saat1) <= CDate(deg2(2)) And CDate(aranan_saat2) >= CDate(deg2(2)) Then
'MsgBox deg2(2)
For s = 0 To UBound(deg2)

Cells(sat, s + 3) = deg2(s)
Next

Cells(sat, 1) = deg1
sat = sat + 1
End If
End If

End If
atla1:
Loop
atla:
Close #1
atla2:
Application.ScreenUpdating = True
zBitis = TimeValue(Now)
MsgBox "işlem tamam Geçen Süre " & CDate(zBitis - ZBasla) & Chr(10) & "veriler alınmıştır.", vbOKOnly + vbInformation, "uyarı"


End Sub

yukarıdaki kodu çalıştırdığında A-P hücreleri aralığına veriler gelecek buradan C-P aralığındaki verileri istediğin gibi değiştir. ve aşağıdaki kodu çalıştır.

Kod:

Sub değiştir()
yol = ThisWorkbook.Path
ZBasla = TimeValue(Now)

sat = 1
Application.ScreenUpdating = False
sat = 2
say = 0
say2 = 0
deg3 = "*"

dosya1 = Cells(1, 20).Value
dosya2 = Cells(2, 20).Value

'On Error Resume Next
Open dosya1 For Input As #1

Open dosya2 For Output As #2
Do While Not EOF(1)
Line Input #1, deg1

deg3 = deg1
If deg1 = aranan_durak Then
say = 1
End If

If say = 1 Then

If Mid(Trim(deg1), 1, 1) = "*" Then
say2 = say2 + 1
End If


If say2 < 2 Then
'GoTo atla
'End If


If Mid(deg1, 1, 1) = "$" Then GoTo atla

deg2 = Split(Trim(deg1), ";")
If UBound(deg2) > 0 Then
'MsgBox CDate(deg2(2)) & Chr(10) & CDate(aranan_saat1)
If CDate(aranan_saat1) <= CDate(deg2(2)) And CDate(aranan_saat2) >= CDate(deg2(2)) Then
'MsgBox deg2(2)
For k = 1 To 14
If k = 1 Then
deg3 = Cells(sat, k + 2)
Else
If k = 3 Then

deg3 = deg3 & ";" & CDate(Format(Cells(sat, k + 2), "hh:nn:ss"))

Else

deg3 = deg3 & ";" & Cells(sat, k + 2)
End If
End If
'MsgBox deg3

Next k

sat = sat + 1
End If
End If

End If

End If
atla:
Print #2, deg3

Loop

Close #2
Close #1

atla2:

Application.ScreenUpdating = True
zBitis = TimeValue(Now)
MsgBox "işlem tamam Geçen Süre " & CDate(zBitis - ZBasla) & Chr(10) & "veriler alınmıştır.", vbOKOnly + vbInformation, "uyarı"

End Sub

not: kodların hepsi aynı modulde olacak yoksa kodlar çalışmaz.

castoridae · 4 Ekim 2016

halit3' Alıntı:

T1 hücresine düzeltilecek dosyanın adresini yaz.
T2 hücresine çıktı alınacak dosya adresini yaz.

bir modül oluştuır ve en üste bu verileri yapıştır.

Kod:

Const aranan_durak = [COLOR="Red"]"* Satır_2"[/COLOR]
Const aranan_saat1 = [COLOR="red"]"06:20:00"[/COLOR]
Const aranan_saat2 = [COLOR="red"]"06:50:00"[/COLOR]

kırmızı yerleri kendin değiştireceksin.

sonra hemen bu verilerin altına bu kodu kopyala yapıştır.

Kod:

Sub verial()

'Columns("A:A").ClearContents
ZBasla = TimeValue(Now)

Range("A2:Q500").ClearContents
  
dosya = Cells(1, 20).Value

sat = 1
Application.ScreenUpdating = False
sat = 2
say = 0
say2 = 0

'On Error Resume Next
Open dosya For Input As #1
 
Do While Not EOF(1)
Line Input #1, deg1

If deg1 = aranan_durak Then
say = 1
End If

If say = 1 Then

If Mid(Trim(deg1), 1, 1) = "*" Then
say2 = say2 + 1

If say2 = 2 Then
GoTo atla
End If
End If

If Mid(deg1, 1, 1) = "$" Then GoTo atla1

deg2 = Split(Trim(deg1), ";")
If UBound(deg2) > 0 Then
'MsgBox CDate(deg2(2)) & Chr(10) & CDate(aranan_saat1)
If CDate(aranan_saat1) <= CDate(deg2(2)) And CDate(aranan_saat2) >= CDate(deg2(2)) Then
'MsgBox deg2(2)
For s = 0 To UBound(deg2)

Cells(sat, s + 3) = deg2(s)
Next

Cells(sat, 1) = deg1
sat = sat + 1
End If
End If

End If
atla1:
Loop
atla:
Close #1
atla2:
Application.ScreenUpdating = True
zBitis = TimeValue(Now)
MsgBox "işlem tamam Geçen Süre " & CDate(zBitis - ZBasla) & Chr(10) & "veriler alınmıştır.", vbOKOnly + vbInformation, "uyarı"


End Sub

yukarıdaki kodu çalıştırdığında A-P hücreleri aralığına veriler gelecek buradan C-P aralığındaki verileri istediğin gibi değiştir. ve aşağıdaki kodu çalıştır.

Kod:

Sub değiştir()
yol = ThisWorkbook.Path
ZBasla = TimeValue(Now)

sat = 1
Application.ScreenUpdating = False
sat = 2
say = 0
say2 = 0
deg3 = "*"

dosya1 = Cells(1, 20).Value
dosya2 = Cells(2, 20).Value

'On Error Resume Next
Open dosya1 For Input As #1

Open dosya2 For Output As #2
Do While Not EOF(1)
Line Input #1, deg1

deg3 = deg1
If deg1 = aranan_durak Then
say = 1
End If

If say = 1 Then

If Mid(Trim(deg1), 1, 1) = "*" Then
say2 = say2 + 1
End If


If say2 < 2 Then
'GoTo atla
'End If


If Mid(deg1, 1, 1) = "$" Then GoTo atla

deg2 = Split(Trim(deg1), ";")
If UBound(deg2) > 0 Then
'MsgBox CDate(deg2(2)) & Chr(10) & CDate(aranan_saat1)
If CDate(aranan_saat1) <= CDate(deg2(2)) And CDate(aranan_saat2) >= CDate(deg2(2)) Then
'MsgBox deg2(2)
For k = 1 To 14
If k = 1 Then
deg3 = Cells(sat, k + 2)
Else
If k = 3 Then

deg3 = deg3 & ";" & CDate(Format(Cells(sat, k + 2), "hh:nn:ss"))

Else

deg3 = deg3 & ";" & Cells(sat, k + 2)
End If
End If
'MsgBox deg3

Next k

sat = sat + 1
End If
End If

End If

End If
atla:
Print #2, deg3

Loop

Close #2
Close #1

atla2:

Application.ScreenUpdating = True
zBitis = TimeValue(Now)
MsgBox "işlem tamam Geçen Süre " & CDate(zBitis - ZBasla) & Chr(10) & "veriler alınmıştır.", vbOKOnly + vbInformation, "uyarı"

End Sub

not: kodların hepsi aynı modulde olacak yoksa kodlar çalışmaz.

Hocam ellerine sağlık. Ancak şimdi bakma fırsatım oldu kodlara ve çok iyi şekilde çalışıyorlar. İyice inceledikten sonra kod hakkında bir iki şey soracağım müsadenizle. Tekrardan teşekkürler, çok yardımcı oldunuz.

Excel'den txt dosyasının istenilen kısmına veri aktarma

castoridae

TEGCreative

castoridae

halit3

Uzman

castoridae

castoridae

halit3

Uzman

castoridae