TEXT dosyasından veri alma

polokomus · 15 Ocak 2010

Merhabalar;
Örnekteki görüldüğü gibi OrnekVeriAl.xls dosyası c:\ornek.txt dosyasından veriyi okuyup A sütununa kopyalıyor. Makro birden fazla çalıştırıldığında ise B C ve E sütunlarını sağa atıyor. Benim istediğim ise, kaç kere çalışırsa çalışsın makronun bu txt dosyasındaki veriyi A sütununa kopyalayıp diğer sütunları etkilememesi. Umarım anlatabilmişimdir.

Yardımlarınız için şimdiden teşekkür ederim

Necdet · 15 Ocak 2010

Merhaba,

Aşağıdaki kodları bir modüle kopyalayıp dener misiniz.

Kod:

Sub VeriAl()
Dim Satir As Long
Range("A:A").ClearContents
Open "C:\ornek.txt" For Input As #1
Do While Not EOF(1)
    Input #1, Kayit
    If Kayit <> Empty Then
        Satir = Satir + 1
        Cells(Satir, "A") = Kayit
    End If
Loop
Close #1
End Sub

polokomus · 15 Ocak 2010

İyi geceler Sayın Necdet Yeşertener;

Elinize, aklınıza sağlık. Kod işimi gördü. Tekrar teşekkür ederim

Orion1 · 15 Ocak 2010

Dosyanız ektedir.

Kod:

Sub TXTAL()
Dim sh As Worksheet, sat As Long
Set sh = Sheets("Sayfa1")
sh.Range("A:A").ClearContents
sat = 1
Open "C:\ornek.txt" For Input As #1
Do While Not EOF(1)
    Input #1, a
    sh.Cells(sat, "A").Value = a
    sat = sat + 1
Loop
Close #1
MsgBox "Txt Dosyasından veriler alındı." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub

polokomus · 15 Ocak 2010

Son bir soru daha Sayın Necdet Yeşertener; Text dosyasındaki veriyi a10 hücresine yazdırmak mümkün müdür?

Tekrar teşekkürler

Düzeltme: Sayın Evren Gizlen Size de ilgileriniz için çok teşekkür ederim. Aynı soru için ne yapılabilir? Sağolun

Necdet · 15 Ocak 2010

polokomus' Alıntı:
Son bir soru daha Sayın Necdet Yeşertener; Text dosyasındaki veriyi a10 hücresine yazdırmak mümkün müdür?

Tekrar teşekkürler

Düzeltme: Sayın Evren Gizlen Size de ilgileriniz için çok teşekkür ederim. Aynı soru için ne yapılabilir? Sağolun

Sanırım A10 hücresinden başlamasını istiyorsunuz.
Bu durumda Ben kod değiştirmekten ziyade Evren beyin kodu üzerinde bir değişiklik önereyim.

sat=1

Satırını

sat = 10

olarak değiştirip kodları deneyiniz.

polokomus · 15 Ocak 2010

Sayın Necdet Yeşertener, Sayın Evren Gizlen;

İlgileriniz için çok teşekkür ederim gecenin bu saatinde... Sayın Necdet Yeşertener sorumun cevabını verdiniz. Allan razı olsun.

Necdet · 15 Ocak 2010

Siz sağolunuz.

DervishH · 16 Ocak 2010

Evren Gizlen' Alıntı:

Dosyanız ektedir.

Kod:

Sub TXTAL()
Dim sh As Worksheet, sat As Long
Set sh = Sheets("Sayfa1")
sh.Range("A:A").ClearContents
sat = 1
Open "C:\ornek.txt" For Input As #1
Do While Not EOF(1)
    Input #1, a
    sh.Cells(sat, "A").Value = a
    sat = sat + 1
Loop
Close #1
MsgBox "Txt Dosyasından veriler alındı." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub

arkadaşım öncelikle emeğine sağlık...
mümkün olursa bikaç şey daha isteyecektim...
1-örnek.txt den aldığımız verileri exele her sütuna bir harf gelecek şeklinde olabilir mi?
2-Exelde yaptığımız değişiklik tekrardan örnek.txt ye kayıt ettirilebilir mi?
3-önek.txt yerine biz istediğimiz bir .txt dosyayı seçebilirmiyiz ?

Teşekkürler

Orion1 · 16 Ocak 2010

DervishH' Alıntı:
arkadaşım öncelikle emeğine sağlık...
mümkün olursa bikaç şey daha isteyecektim...
1-örnek.txt den aldığımız verileri exele her sütuna bir harf gelecek şeklinde olabilir mi?
2-Exelde yaptığımız değişiklik tekrardan örnek.txt ye kayıt ettirilebilir mi?
3-önek.txt yerine biz istediğimiz bir .txt dosyayı seçebilirmiyiz ?

Teşekkürler

her 2 isteğinizi yaptım.
TXT uku sayfasında ilk isteiğiniz.
TXT YAZ sayfasında 2nci isteiğiniz.
txt yza ve oku sayfasında aşğıhğıdaki kodlarda yolunu ve adını kırmızı ile renklendirdiğim yerlerde istediğiniz şekilde ayarlayabilirisiniz.
Dosyanız ektedir.

Kod:

Sub TXTAL()
Dim sh As Worksheet, sat As Long, i As Integer
Set sh = Sheets("TXT_OKU")
sh.Range("A2:IV65536").ClearContents
sat = 2
Open "[B][COLOR="Red"]C:\ornek.txt[/COLOR][/B]" For Input As #1
Do While Not EOF(1)
    Input #1, a
    sh.Cells(sat, "A").Value = a
    For i = 1 To Len(a)
        sh.Cells(sat, i + 1).Value = Mid(a, i, 1)
    Next
    sat = sat + 1
Loop
Close #1
MsgBox "Txt Dosyasından veriler alındı." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub
Sub txt_yaz()
Dim sh As Worksheet, sat As Long, i As Integer
Set sh = Sheets("TXT_YAZ")
sat = sh.Cells(65536, "A").End(xlUp).Row
Open "[B][COLOR="Red"]C:\ornek.txt[/COLOR][/B]" For Output As #1
For i = 2 To sat
    Write #1, sh.Cells(i, "A").Value
Next
Close #1
MsgBox "Txt Dosyasında veriler yazıldı." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub

polokomus · 16 Ocak 2010

Merhaba Sayın Evren Gizlen Ve Sayın Necdet Yeşertener;

İlgileriniz için teşekkür ederim, sağolun.

Son bir şey aklıma geldi tabii yapılabiliyor ise;

Bu mesajda eklemiş olduğum dosyalar ile:

ornek.txt dosyasında sadece bir kullanıcının ismi yazıyor.
OrnekVeriAl.xls dosyası bu veriyi okuduğunda, A10 hücresine yazıyor. Buraya kadar Tamam. ornek.txt dosyasında Murat, Ayse veya Ali yazıyor ise "copy, paste, cut, farklı kaydet, kaydet, yazdır " tuşları ve kısayolları çalışabilsin, Farklı bir isim yazıyor ise bu komutlar tüm sayfalarda (Sayfa1, Sayfa2...) kullanılamasın. Böyle bir şey mümkün müdür?

Saygılarımla, tekrar çok teşekkür ederim..

DervishH · 30 Ocak 2010

Evren arkadaşım teşekkürler eline sağlık

polokomus · 30 Ocak 2010

Tekrar Merhabalar; Sayın Necdet Yeşertener ve Evren Gizlen katkılarıyla yapılmış olan
Ekteki dosyada c:\ornek.txt içerisinden veri alınıp A10 hücresine yazılıyor.
Eğer c:\ornek.txt yok ise veya c:\sürücüsü yok ise, bunları kontrol edip d:\ornek.txt den veri almak mümkün müdür? D:\ sürücüsünün mutlaka var olduğu biliniyor.

Teşekkürler...

halit3 · 30 Ocak 2010

bu kod bütün sürücülerin içini tarıyor ve örnek dosyayı ilk nerde bulursa oradan veri alıyor

Sub VeriAl()
Dim sat As Long
Range("A:A").ClearContents
Dim ds, dc, s, a
Set ds = CreateObject("Scripting.FileSystemObject")
Set dc = ds.Drives
For Each sürücü In dc
s = s & vbCrLf & sürücü
yer = sürücü & "\ornek.txt"
a = ds.FileExists(yer)
If a = True Then
MsgBox yer & " Bu isimde bir dosya " & sürücü & " sünde var"
Open yer For Input As #1
Do While Not EOF(1)
Input #1, a
If a <> Empty Then
sat = sat + 10
Cells(sat, "A") = a
End If
Loop
Close #1
Exit Sub
End If
Next
End Sub

polokomus · 31 Ocak 2010

Sayın Halit Özdemir; Dün cevap veremediğim için özür dilerim. Kodunuz tam istediğim gibi olmuş. Çok teşekkür ederim. Emeğinize bilgilerinize sağlık.

halit3 · 31 Ocak 2010

polokomus' Alıntı:
Sayın Halit Özdemir; Dün cevap veremediğim için özür dilerim. Kodunuz tam istediğim gibi olmuş. Çok teşekkür ederim. Emeğinize bilgilerinize sağlık.

iyi çalışmalar

DervishH · 3 Şubat 2010

Evren Gizlen' Alıntı:

her 2 isteğinizi yaptım.
TXT uku sayfasında ilk isteiğiniz.
TXT YAZ sayfasında 2nci isteiğiniz.
txt yza ve oku sayfasında aşğıhğıdaki kodlarda yolunu ve adını kırmızı ile renklendirdiğim yerlerde istediğiniz şekilde ayarlayabilirisiniz.
Dosyanız ektedir.

Kod:

Sub TXTAL()
Dim sh As Worksheet, sat As Long, i As Integer
Set sh = Sheets("TXT_OKU")
sh.Range("A2:IV65536").ClearContents
sat = 2
Open "[B][COLOR="Red"]C:\ornek.txt[/COLOR][/B]" For Input As #1
Do While Not EOF(1)
    Input #1, a
    sh.Cells(sat, "A").Value = a
    For i = 1 To Len(a)
        sh.Cells(sat, i + 1).Value = Mid(a, i, 1)
    Next
    sat = sat + 1
Loop
Close #1
MsgBox "Txt Dosyasından veriler alındı." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub
Sub txt_yaz()
Dim sh As Worksheet, sat As Long, i As Integer
Set sh = Sheets("TXT_YAZ")
sat = sh.Cells(65536, "A").End(xlUp).Row
Open "[B][COLOR="Red"]C:\ornek.txt[/COLOR][/B]" For Output As #1
For i = 2 To sat
    Write #1, sh.Cells(i, "A").Value
Next
Close #1
MsgBox "Txt Dosyasında veriler yazıldı." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub

-----ORNEK.TXT 'DEN verileri aldıktan sonra---- bir değişiklik yapınca (ÖRN' b3 te yada c3'te) TXT_YAZ sayfasında da değişiklik olması ve yazdır deyince ornek.txt'ye yaptığımız değişikliklerin kaydedilmesi mümkünmü acaba.

Orion1 · 3 Şubat 2010

DervishH' Alıntı:
-----ORNEK.TXT 'DEN verileri aldıktan sonra---- bir değişiklik yapınca (ÖRN' b3 te yada c3'te) TXT_YAZ sayfasında da değişiklik olması ve yazdır deyince ornek.txt'ye yaptığımız değişikliklerin kaydedilmesi mümkünmü acaba.

txt_yaz prosedürünü kullanabilirsiniz.

kayserciyes · 8 Aralık 2011

ARKADAŞLAR aşağıdaki kodla veri aldığımda

1 satırdan itibaren başlıyo ben istiyorum ki 9.satırdan başlasın

satır 9 yapıncada 9 ar ara ile veri alıyor

yani sadece veri alamaya başladığı ilk satır 9.satır olacak nasıl yapacağım

Sub ZCD_28_VERİ_AKTAR()
Dim i As Long, deg As String, sat As Long, deg2, k As Byte, dosya
Range("A1:JW65536").ClearContents
ChDir (ThisWorkbook.Path)
dosya = Application.GetOpenFilename(filefilter:="Metin dosyaları(*.txt),(*.txt)", Title:="Bir metin dosyası seçiniz.")
If dosya = False Then Exit Sub
Sheets("Sayfa1").Select
Application.ScreenUpdating = False
Open dosya For Input As #1
Do While Not EOF(1)
Line Input #1, Kayıt
Satır = Satır + 1
Cells(Satır, 3) = Mid(Kayıt, 1, 6)
Cells(Satır, 4) = Mid(Kayıt, 8, 6)
Cells(Satır, 5) = Convert(Mid(Kayıt, 15, 11))
Cells(Satır, 6) = Convert(Mid(Kayıt, 27, 11))
Cells(Satır, 7) = Convert(Mid(Kayıt, 39, 1))
Cells(Satır, 8).NumberFormat = "@"
Cells(Satır, 8) = Mid(Kayıt, 41, 2)

Loop
Close #1
Cells.EntireColumn.AutoFit
End Sub

Function Convert(Veri As String)
Veri = Replace(Veri, Chr(154), "Ü")
Veri = Replace(Veri, Chr(166), "Ğ")
Veri = Replace(Veri, Chr(158), "Ş")
Veri = Replace(Veri, Chr(128), "Ç")
Veri = Replace(Veri, Chr(153), "Ö")
Veri = Replace(Veri, Chr(152), "İ")
Convert = Replace(Veri, Chr(15), "")
End Function

Necdet · 8 Aralık 2011

Merhaba,

Aşağıdaki şekilde dener misiniz?

Kod:

Sub ZCD_28_VERİ_AKTAR()
    Dim i As Long, deg As String, sat As Long, deg2, k As Byte, dosya
    Range("A1:JW65536").ClearContents
    ChDir (ThisWorkbook.Path)
    dosya = Application.GetOpenFilename(filefilter:="Metin dosyaları(*.txt),(*.txt)", Title:="Bir metin dosyası seçiniz.")
    If dosya = False Then Exit Sub
    Sheets("Sayfa1").Select
    Application.ScreenUpdating = False
    Open dosya For Input As #1
    Do While Not EOF(1)
        Line Input #1, Kayıt
        Satır = Satır + 1
        [COLOR=red]If Satır > 8 Then
[/COLOR]            Cells(Satır [COLOR=red]- 8[/COLOR], 3) = Mid(Kayıt, 1, 6)
            Cells(Satır [COLOR=red]- 8[/COLOR], 4) = Mid(Kayıt, 8, 6)
            Cells(Satır [COLOR=red]- 8[/COLOR], 5) = Convert(Mid(Kayıt, 15, 11))
            Cells(Satır [COLOR=red]- 8[/COLOR], 6) = Convert(Mid(Kayıt, 27, 11))
            Cells(Satır [COLOR=red]- 8[/COLOR], 7) = Convert(Mid(Kayıt, 39, 1))
            Cells(Satır[COLOR=red] - 8[/COLOR], 8).NumberFormat = "@"
            Cells(Satır [COLOR=red]- 8[/COLOR], 8) = Mid(Kayıt, 41, 2)
       [COLOR=red] End If
[/COLOR]    Loop
    Close #1
    Cells.EntireColumn.AutoFit
End Sub

TEXT dosyasından veri alma

polokomus

Ekli dosyalar

Necdet

Moderatör

Ekli dosyalar

polokomus

Orion1

Uzman

Ekli dosyalar

polokomus

Necdet

Moderatör

polokomus

Necdet

Moderatör

DervishH

Orion1

Uzman

Ekli dosyalar

polokomus

Ekli dosyalar

DervishH

polokomus

Ekli dosyalar

halit3

Uzman

polokomus

halit3

Uzman

DervishH

Orion1

Uzman

kayserciyes

Necdet

Moderatör