• DİKKAT

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

Txt veri alma

Evren Gizlen' Alıntı:
Edebiliriz.
Kodunuzu görelim.:cool:
Genişletmek için tıkla ...


Aşağıdaki kodu kullanarak *.txt dosyasını çağırıyorum fakat çağırdığım kodlar A1 den başlamasın. A24'den başlasın ve A1 ile A23 deki verileri silmesin.

Kolay gelsin.

Sub VeriAl()
Dim Satir As Long
Range("A:A").ClearContents
ChDir ("C:\")
dosya = Application.GetOpenFilename(FileFilter:="txt Dosyaları(*.txt),(*txt)", Title:="txt Dosyası Aç")
If dosya = False Then Exit Sub
Open dosya 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
 
cngzklc' Alıntı:
Aşağıdaki kodu kullanarak *.txt dosyasını çağırıyorum fakat çağırdığım kodlar A1 den başlamasın. A24'den başlasın ve A1 ile A23 deki verileri silmesin.

Kolay gelsin.

Sub VeriAl()
Dim Satir As Long
Range("A:A").ClearContents
ChDir ("C:\")
dosya = Application.GetOpenFilename(FileFilter:="txt Dosyaları(*.txt),(*txt)", Title:="txt Dosyası Aç")
If dosya = False Then Exit Sub
Open dosya 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
Genişletmek için tıkla ...
:cool:
Kod: 
Sub VeriAl()
Dim Satir As Long
Range([B][COLOR="Red"]"A24:A65536"[/COLOR][/B]).ClearContents
ChDir ("C:\")
dosya = Application.GetOpenFilename(FileFilter:="txt Dosyaları(*.txt),(*txt)", Title:="txt Dosyası Aç")
If dosya = False Then Exit Sub
[B][COLOR="Red"]Satir=24[/COLOR][/B]
Open dosya For Input As #1
Do While Not EOF(1)
    Input #1, Kayit
    If Kayit <> Empty Then
        Cells(Satir, "A") = Kayit
         [B][COLOR="Red"]Satir = Satir + 1[/COLOR][/B]
    End If
Loop
Close #1
End Sub
 
Evren Gizlen' Alıntı:
:cool:
Kod: 
Sub VeriAl()
Dim Satir As Long
Range([B][COLOR="Red"]"A24:A65536"[/COLOR][/B]).ClearContents
ChDir ("C:\")
dosya = Application.GetOpenFilename(FileFilter:="txt Dosyaları(*.txt),(*txt)", Title:="txt Dosyası Aç")
If dosya = False Then Exit Sub
[B][COLOR="Red"]Satir=24[/COLOR][/B]
Open dosya For Input As #1
Do While Not EOF(1)
    Input #1, Kayit
    If Kayit <> Empty Then
        Cells(Satir, "A") = Kayit
         [B][COLOR="Red"]Satir = Satir + 1[/COLOR][/B]
    End If
Loop
Close #1
End Sub
Genişletmek için tıkla ...



Evren Hocam,

Birkez daha çok teşekkur ederim. Allah ne muradın varsa versin. :)
İyi çalışmalar.
 
Benim soruma cevap verebilecek var mı acaba ?

Araya kaynadı :D
 
Evren Gizlen' Alıntı:
:cool:
Kod: 
Sub VeriAl()
Dim Satir As Long
Range([B][COLOR="Red"]"A24:A65536"[/COLOR][/B]).ClearContents
ChDir ("C:\")
dosya = Application.GetOpenFilename(FileFilter:="txt Dosyaları(*.txt),(*txt)", Title:="txt Dosyası Aç")
If dosya = False Then Exit Sub
[B][COLOR="Red"]Satir=24[/COLOR][/B]
Open dosya For Input As #1
Do While Not EOF(1)
    Input #1, Kayit
    If Kayit <> Empty Then
        Cells(Satir, "A") = Kayit
         [B][COLOR="Red"]Satir = Satir + 1[/COLOR][/B]
    End If
Loop
Close #1
End Sub
Genişletmek için tıkla ...


Evren Hocam tekrar merhabalar,
Yukarıdaki kodlarla txt'den aldığım veriler, excel içerisinde bozuluyor.
Ekteki dosyada excel içerisine veri aldığım txt dosyası mevcut.
Ben bu dosyayı excel'e çağırdığımda örneğin; 1015-696 satırı excel içerisinde sadece 1015 olarak görünüyor. -696 gidiyor.
Hücre biçimini text olarak ayarlıyorum ama yine bunun gibi hücrelerde değişiklik oluyor.
Bu durumu nasıl engelleyebiliriz.
Yardımcı olabilirmisiniz.
 

Ekli dosyalar

İlgili satır aşağıdaki ile değiştiriniz.:cool:
Kod: 
Line Input #1, Kayit
 
Teşekkur ederim. Çok sağolun.
Çok fazla oluyorum galiba da.
A27 hücresinde +değer1+değer2 verisi var.
değer2 sürekli değişkendir ve inpubox ile nasıl değiştirebilirim.
+değer1+....... noktalı kısım sürekli değişecek.
 
Son düzenleme:
cngzklc' Alıntı:
Teşekkur ederim. Çok sağolun.
Çok fazla oluyorum galiba da.
A27 hücresinde +değer1+değer2 verisi var.
değer2 sürekli değişkendir ve inpubox ile nasıl değiştirebilirim.
+değer1+....... noktalı kısım sürekli değişecek.
Genişletmek için tıkla ...
Bunu anlamadım.Bu vba kodumudur?:cool:
 
Evren Gizlen' Alıntı:
Bunu anlamadım.Bu vba kodumudur?:cool:
Genişletmek için tıkla ...

Hayır VBA kodu değil. Bu biraz önceki txt dosyası içerisindeki satırlardan biri. (+6722+35905).O satır excel içerisinde A27 hücresine geliyor.
Bende bunu +değer1+değer2 olarak gösterdirdim.
A27 hücresindeki +değer1+değer2 olan verinin sadece değer2 kısmını inputbox ile değiştireceğiz.
input box'a değer5 yazdığımda, A27 hücresindeki veri;
+değer1+değer5 olarak değişecek.

Bir başka değişle. İnputbox'a girilen değer,A27 hücresindeki birinci artıdan(+) sonraki değer değiştirmeyip, ikinci artıdan (+) sonraki değeri değişecek.
 
cngzklc' Alıntı:
Hayır VBA kodu değil. Bu biraz önceki txt dosyası içerisindeki satırlardan biri. (+6722+35905).O satır excel içerisinde A27 hücresine geliyor.
Bende bunu +değer1+değer2 olarak gösterdirdim.
A27 hücresindeki +değer1+değer2 olan verinin sadece değer2 kısmını inputbox ile değiştireceğiz.
input box'a değer5 yazdığımda, A27 hücresindeki veri;
+değer1+değer5 olarak değişecek.

Bir başka değişle. İnputbox'a girilen değer,A27 hücresindeki birinci artıdan(+) sonraki değer değiştirmeyip, ikinci artıdan (+) sonraki değeri değişecek.
Genişletmek için tıkla ...
:cool:
Kod: 
deg = InputBox("Veriyi değiştiriniz : ", "DEĞİŞİKLİK", Range("A27").Value)
If deg = False Then Exit Sub
Range("A27").Value = deg
 
Merhaba,
Üzerinden baya geçmiş konunun ancak yeni bir başlık kullanmak istemedim.
Benim merak ettiğim aynı klasörde birden fazla text uzantılı dosyayı excelde yeni sheetlere almamız mümkün müdür?

yani elimde a bayisinin ve b bayisinin satışları var text halinde
her ay ben bunları excelde birleştiriyorum.

bunu tek tek yapmak zaman alıyor. her bir text dosyasını yeni sheete aktarmak mümkün mü?
Birde texti attıktan sonra son a celline hangi şube olduğu eklemek mümkün müdür yada açılan sheet ismini dosyanın adı ile değiştirmek?
son bir şey daha ben excele attığımda kararterlei tanımıyor. neden kaynaklanıyor olabilir acaba?
Şimdiden teşekkür ederim.
 
Son düzenleme:
Merhaba Sayın gizzemkoc,

Örnek dosya ile sorunuzu desteklerseniz yanıta erişmeniz daha hızlı olacaktır.
 
Necdet bey,
Öncelikle ilgilendiğinizi için teşekkür ederim.

Ekli dosyadaki gibi her ay satırları değişen yüklü datalar alıyorum.
Benim istediğim makro ile işlem yaptıktan sonra bu verilerin alt alta klasördeki bütün bayiler için yapılması. ve eğer mümkünse bayi adının a kolonunda yer alması.

ben bu konularda yeni olduğumdan kaydederek makro üretiyorum ancak he ay satır sayısı değiştiğinden bir türlü alt alta kaydetmeyi başarakamadım. sürekli bir sonraki kayıt için hedef cell istediğinden sonunda pes edip yardım almaya karar verdim.
birde mümkün mü bilmiyorum ama ana klasörde her bölge için listeler geliyor her bir klasörün ayrı sheette sıralanması da yine mümkün müdür? yardımlarınız için teşekkür ederim. Umarım açıklayabilmişimdir.
 

Ekli dosyalar

Merhaba,

Aşağıdaki Kodlar ThisWorkbook un kod bölümünde olmalı.

Kod: 
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
 
    DosyaOku
 
End Sub

Aşağıdaki kodlarda bir modüle kopyalayınız.

Kod: 
Sub DosyaOku()
    Dim Yol     As String, _
        Dosya   As String, _
        Dsy     As String, _
        Satir   As String, _
        i       As Long, _
        Hucreler
    
    Yol = KlasorSec
    If Yol = "" Then Exit Sub
    Yol = Yol & Application.PathSeparator
    
    Dosya = Dir(Yol & "*.txt")
    
    While Dosya <> ""
    
        i = Cells(Rows.Count, "A").End(3).Row
        Dsy = Yol & Dosya
        
        Open Dsy For Input As #1
            Input #1, Satir
            Do While Not EOF(1)
                Input #1, Satir
                If Not Satir = Empty Then
                    Hucreler = Split(Satir, vbTab)
                    i = i + 1
                    Cells(i, "A") = Split(Dosya, ".txt")(0)
                    Range("B" & i).Resize(1, UBound(Hucreler) + 1) = Hucreler
                End If
            Loop
            
            Close #1
    
            Dosya = Dir
    Wend
    
End Sub
Kod: 
Function KlasorSec() As String
    Dim ObjFolder   As Variant
 
    Set ObjFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Lütfen bir klasör seçin !", &H100)
 
    If Not ObjFolder Is Nothing Then
        KlasorSec = ObjFolder.Items.Item.Path
    Else
        KlasorSec = ""
    End If
End Function


Herhangi bir sayfada herhangi bir hücreye çift tıkladığında kodlar çalışacaktır.
Sizin yapmanız gereken şey Text (Metin) dosyalarının bulunduğu klasörü seçmek.

Seçilen klasördeki tüm metin dosyaları aktif olan sayfala kopyalanır.

Not : Bilgiler ardışık olarak eklenir.
 

Ekli dosyalar

Necdet Bey,
Yardımlarınız için çok teşekkür ederim.
makroyu çalıştırmayı denediğimde klasör seçtikten sonra hata veriyor ama neden kaynaklı olduğunu çözemedim. adım adım gittiğimde makro da "Open Dosya For Input As #1" komutuna geldiğinde hata veriyor? ne yapmam gerekir acaba? yardımcı olabilirseniz çok sevinirim.
 
Merhaba,

Kodları ve dosyayı yeniledim, tekrar bakar mısınız?
 
Necdet Bey,
Yardımlarınız için çok teşekkür ederim. elinize ve emeğinize sağlık.:)
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst