• DİKKAT

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

text dosyasından veri almak A stununa

k0081

k0081

Katılım
17 Haziran 2008
Mesajlar
1,874
Excel Vers. ve Dili
Microsoft Ofis Profesyonel 2019 x64 TR
Merhaba arkadaşlar;

bir excel tablosuna buton yardımı ile txt dosyasından veri çekmek istiyorum. örnek dosyayı ekledim..
Ekli dosyayı görüntüle MALZEME.txt

A sutununda olmasını istediğim değerler;

A
CHS80*3
CHS114*3
HEA300
IPE160
IPE360
L170*70*8
PL10*140

gibi..

yardımcı arkadaşa şimdiden teşekkürler..
 
k0081' Alıntı:
Merhaba arkadaşlar;

bir excel tablosuna buton yardımı ile txt dosyasından veri çekmek istiyorum. örnek dosyayı ekledim..
Ekli dosyayı görüntüle 137180

A sutununda olmasını istediğim değerler;

A
CHS80*3
CHS114*3
HEA300
IPE160
IPE360
L170*70*8
PL10*140

gibi..

yardımcı arkadaşa şimdiden teşekkürler..
Genişletmek için tıkla ...

kod:
Kod: 
Sub verial()
dosyaadi = Application.GetOpenFilename("All Files (*.*),*.*.")
If dosyaadi = False Then
MsgBox "Veri alınacak dosyayı seçmediniz.", vbInformation, "DİKKAT"
Exit Sub
Else
End If
Columns("A:A").ClearContents
Open dosyaadi For Input As #1
Do While Not EOF(1)
Line Input #1, a
If Trim(a) <> "" Then
If Left(Trim(a), 1) <> "-" Then
If Mid(Trim(a), 1, 6) <> "Total:" Then
i = i + 1
adres = Trim(a)
son1 = InStr(InStr(Trim(adres), "pieces"), adres, " ", vbTextCompare)
bolme1 = Split(Mid(adres, son1, Len(adres)), " ")
Cells(i, 1).Value = bolme1(1)
End If
End If
End If
Loop
Close
MsgBox "işlem tamam"
End Sub
 
halit3

hocam çok teşekkürler.. elinize sağık, tamamdır..
 
Halit3
hocam bu vemiş olduğunuz kodda işleyiş nasıl oluyor...? şunu öğrenmek isityorum kodların karşısına txt den değere alırken nelere dikkat ediyor.. nasıl alıyor.. kodların karşısına küçük açıklama yazabilirmisiniz? bazen bir değişiklik yapmak gerekiyor.., ama kodları ne iş yaptığını tam olarak bilemediğim için değiştiremiyorum.. saygılarımla..
 
k0081' Alıntı:
Halit3
hocam bu vemiş olduğunuz kodda işleyiş nasıl oluyor...? şunu öğrenmek isityorum kodların karşısına txt den değere alırken nelere dikkat ediyor.. nasıl alıyor.. kodların karşısına küçük açıklama yazabilirmisiniz? bazen bir değişiklik yapmak gerekiyor.., ama kodları ne iş yaptığını tam olarak bilemediğim için değiştiremiyorum.. saygılarımla..
Genişletmek için tıkla ...

Dilim döndüğünce açıklamaya çalıştım.
Burada şunu söylüyeyim açıklamayı yapmak kodu yazmaktan çok daha zor baya zahmetli bir iş çünkü bazen doğru bildiğimiz bir şey yanlış olabiliyor.

kod
Kod: 
Sub verial()
'Text dosyasını seçiyoruz.
dosyaadi = Application.GetOpenFilename("Text Files (*.txt), *.txt")
'dosya seçimi yapılmadıysa
If dosyaadi = False Then
'burada uyarı mesajı verdiriyoruz.
MsgBox "Veri alınacak dosyayı seçmediniz.", vbInformation, "DİKKAT"
'kodu burada sonlandırıyoruz.
Exit Sub
'eğer dosya seçimi yapıldıysa
Else
'buraya kod ve mesaj yazılabilir.
End If
'a sutünundaki hücrelerin içini başaltıyoruz.
Columns("A:A").ClearContents
'seçilen text dosyasını açıyoruz.
Open dosyaadi For Input As #1
'açılan dosya burada döngüye giriyor ve son veriye kadar devam edecek.
Do While Not EOF(1)
'açılan dosyadaki verileri a değeri olarak tanımlıyoruz.
Line Input #1, a
'tanımladığımız a değerine ait aralarındaki birden fazla boşlukları bertaraf ediyoruz ve a değerinin boş olup olmadığını denetliyoruz.
If Trim(a) <> "" Then
'a degerinin ilk karekteri (-) eksi işareti olmuyanı surguluyoruz.
If Left(Trim(a), 1) <> "-" Then
'a degerinin ilk altı karekteri (Totai:) olmuyanı sorguluyoruz.
If Mid(Trim(a), 1, 6) <> "Total:" Then
'sayfadaki hücrelere bu veriyi almak için satır saydırıyoruz yani sayaç olarak her veri aldığında bir alt satıra gitmesi için.
i = i + 1
'burada a değerini adres olarak değişken olarak tanımlıyoruz.
adres = Trim(a)
'a değerinin içinde (pieces) kelimesinin kaçıncı karekterde olduğunu buluyoruz.
son1 = InStr(InStr(Trim(adres), "pieces"), adres, " ", vbTextCompare)
' a değerinin içinde (pieces) kelimesinin kaçıncı karekterde olduğunu bulduktan sonra kalan değerden aralarındaki boşlukları buluyoruz.
bolme1 = Split(Mid(adres, son1, Len(adres)), " ")
' a değerinin içinde (pieces) kelimesin den sonraki kaçıncı boşluktan diğer boşluka kadar olan kısımı buluyoruz.
' burada boşlukların başlangıcı sıfırdır biz ikinci boşluğu yani birinci degeri alıyoruz. ve A sutununa ilgili sayaç satırına yazdırıyoruz.
'bolme1(0)
'bolme1(1)
'bolme1(2)
'gibi
Cells(i, 1).Value = bolme1(1)
End If
End If
End If
'döngü burada bitiyor.
Loop
'text dosyasını kapatıyoruz.
Close
'uyarı mesakı verdiriyoruz.
MsgBox "işlem tamam"
End Sub

İyi çalışmalar
 
halit3

Hocam çok teşekkürler,, sağolasın.eyvallah.. saygılar..
 
Halit3

hocam bu soruda şöyle bir eksiklik olmuş, diğer malzeme dosyasını alınca fark ettim.. şimdi göndermiş olduğum ekli dosyada aynı isimden iki tane malzeme varsa mesela HEA300 bunun sadece bir tanesi A stununa yazsın..(A55 ten öncesine) bir de PL ile başlayan malzemeleri A55 ten itibaren yazsın... PL ile başlayan ifadeleri PL10* şeklinde yazması yeterli.

PL ile başlayan malzemelere örnek veriyorum. (txt dosyasında yazan..)

PL10*170
PL10*120
PL10*100
PL10*250
PL15*142
PL15*90
PL15*80
PL20*125
PL20*14
PL20*190

A sutununda olmasını istediğim değerler;

A
CHS80*3
CHS114*3
HEA300
IPE160
IPE360
L170*70*8
------
-----
-----
----

A55
PL10*
PL15*
PL20*

Şeklinde alması yeterli...

gibi..

yardımcı arkadaşa şimdiden teşekkürler..[/QUOTE]
 
Son düzenleme:
k0081' Alıntı:
Halit3

hocam bu soruda şöyle bir eksiklik olmuş, diğer malzeme dosyasını alınca fark ettim.. şimdi göndermiş olduğum ekli dosyada aynı isimden iki tane malzeme varsa mesela HEA300 bunun sadece bir tanesi A stununa yazsın..(A55 ten öncesine) bir de PL ile başlayan malzemeleri A55 ten itibaren yazsın... PL ile başlayan ifadeleri PL10* şeklinde yazması yeterli.

PL ile başlayan malzemelere örnek veriyorum. (txt dosyasında yazan..)

PL10*170
PL10*120
PL10*100
PL10*250
PL15*142
PL15*90
PL15*80
PL20*125
PL20*14
PL20*190

A sutununda olmasını istediğim değerler;

A
CHS80*3
CHS114*3
HEA300
IPE160
IPE360
L170*70*8
------
-----
-----
----

A55
PL10*
PL15*
PL20*

Şeklinde alması yeterli...

gibi..

yardımcı arkadaşa şimdiden teşekkürler..
Genişletmek için tıkla ...
[/quote]

7 nolu mesajınızda sorununuzun cözöldüğü görülüyor.
Oysa 9 nolu mesajınızdaki soru ile 1 nolu mesajınızdaki sorular çok farklı
9 nolu mesajınızdada örnek dosya yok ve şimdi kodların hepsini yeniden yazmak gerekecek buda baya zahmetli bir iş halbuki size kodların açıklamasınıda yazmıştım.
 

Ekli dosyayı görüntüle MALZEME2.txt

haklısınız hocam.. sizin vermiş olduğunuz açıklamalar oldukça güzel. ve işime de çok yaradı.. dün akşam epey bir uğraştım.. PL ile başlayan ifadelerde sıkıntı olduğu için devam niteliğnde sormuştum..

hakslısınız bu durumda kodlar tekrar yazılacak.. müsait olduğunuzda bakabilirseniz sevinirim.. yoksa Sorun değil.. saygılar..
 
Kod:

Kod: 
Sub verial()
sat = 55
dosyaadi = Application.GetOpenFilename("Text Files (*.txt), *.txt")
If dosyaadi = False Then
MsgBox "Veri alınacak dosyayı seçmediniz.", vbInformation, "DİKKAT"
Exit Sub
Else
End If
Columns("A:A").ClearContents
Open dosyaadi For Input As #1
Do While Not EOF(1)
Line Input #1, a
If Trim(a) <> "" Then
If Left(Trim(a), 1) <> "-" Then
If Mid(Trim(a), 1, 6) <> "Total:" Then
If Mid(Trim(a), 1, 6) = "Total " Then
adres = Trim(a)
son1 = InStr(InStr(Trim(adres), "pieces"), adres, " ", vbTextCompare)
bolme1 = Split(Mid(adres, son1, Len(adres)), " ")
If Mid(bolme1(1), 1, 2) <> "PL" Then
i = i + 1
Cells(i, 1).Value = bolme1(1)
Else
If WorksheetFunction.CountIf(Range("A55:A65000" & r), Mid(bolme1(1), 1, 5)) = 0 Then
Cells(sat, 1).Value = Mid(bolme1(1), 1, 5)
sat = sat + 1
End If
End If
End If
End If
End If
End If
Loop
Close
MsgBox "işlem tamam"
End Sub
 
halit3

hocam çok teşekkürler.. tamamdır.. zahmet verdim..

sağolun. Allah razı olsun..
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst