ExcelVBA.Net sitesine katkıda bulunabilirsiniz

[bozkurt43]

öncelikle merhabalar
Benim elimde bir klasör var ve bu klasörün içinde makro yardımı ile seçtiğim txt dosyasında ki verileri sayfaya aktarmak istiyorum
bu konuda yardımcı olur musunuz ayırac konusunda ve dosya seçme konusunda sıkıntılar oluyor yardımcı olursanız sevinirim

[dogankarun]

Merhabalar,
"Veri - Metni Sütunlara Dönüştür" denediniz mi?

[bozkurt43]

vba üzerinde kullanacağım kodları düzenleme yapamadım...
excel üzerinden tek tek yapılabilir ama hergün güncel veri onları örnek olarak attım günde 2 veya 3 dosya oluşuyor bu verileri kullanıyorum vba üzerinden bir tıklama ile yapıp ben bunları filtreleme yapmak istiyorum ordan çektiğim dosya sorgu olarak kalıyor ve makroya bağlayamadım hep aynı dosya oluyor

[dogankarun]

vba üzerinde kullanacağım kodları düzenleme yapamadım...
excel üzerinden tek tek yapılabilir ama hergün güncel veri onları örnek olarak attım günde 2 veya 3 dosya oluşuyor bu verileri kullanıyorum vba üzerinden bir tıklama ile yapıp ben bunları filtreleme yapmak istiyorum ordan çektiğim dosya sorgu olarak kalıyor ve makroya bağlayamadım hep aynı dosya oluyor

Excel dosyanızı paylaşabilirseniz yardımcı olan çıkar. Çözüm yolu bulabilirsem bende yardımcı olurum inşaallah.
Kolay Gelsin.

[halily]

aşağıdaki dosyayı inceler misiniz?
Not : karışıklık olmasın diye veri alınacak dosyaları DATA klasörünü oluşturup oraya koydum

Kod: Tümünü seç

Sub VeriAlADO()
t1 = Timer
AnaKlsr = ThisWorkbook.Path & "\DATA\"

Dim dzBoyt As Variant
ReDim dzBoyt(1 To 12, 1 To 2)
         dzBoyt(1, 1) = 1:   dzBoyt(1, 2) = 10
         dzBoyt(2, 1) = 12:  dzBoyt(2, 2) = 8
         dzBoyt(3, 1) = 21:  dzBoyt(3, 2) = 31
         dzBoyt(4, 1) = 52:  dzBoyt(4, 2) = 8
         dzBoyt(5, 1) = 59:  dzBoyt(5, 2) = 10
         dzBoyt(6, 1) = 68:  dzBoyt(6, 2) = 12
         dzBoyt(7, 1) = 79:  dzBoyt(7, 2) = 8
         dzBoyt(8, 1) = 86:  dzBoyt(8, 2) = 6
         dzBoyt(9, 1) = 91:  dzBoyt(9, 2) = 10
        dzBoyt(10, 1) = 101: dzBoyt(10, 2) = 3
        dzBoyt(11, 1) = 103: dzBoyt(11, 2) = 4
        dzBoyt(12, 1) = 106: dzBoyt(12, 2) = 10


Dim s As Object ' ADODB.Stream
Set s = CreateObject("adodb.Stream")
    s.Charset = "ISO-8859-9" '"utf-8"
    s.Open
     Set FSO = CreateObject("Scripting.FileSystemObject")
Set xRs = CreateObject("ADODB.Recordset")
With xRs
    For Aln = 1 To 12
        .Fields.Append "Aln" & Aln - 1, 8
    Next
    .Open
End With
With FSO
    Set sht = ThisWorkbook.Sheets("sayfa2")
'        sht.Cells.Clear
    If .FolderExists(AnaKlsr) Then
        For Each f In .GetFolder(AnaKlsr).Files
'        Debug.Print f
            s.LoadFromFile (f)
            Dim txt As String
            txt = s.ReadText
            DzStr = Split(txt, vbNewLine)
                 For x = 2 To UBound(DzStr)
                 xMtn = ""
                        For y = 1 To 12
                            xMtn = xMtn & "æ|@" & Mid(DzStr(x), dzBoyt(y, 1), dzBoyt(y, 2)) & " "
                        Next y
'                Debug.Print Mid(xMtn, 4)
                TmpDz = Split(Mid(xMtn, 4), "æ|@")
                xRs.AddNew
                For xAln = 0 To 11
                    xRs(xAln) = TmpDz(xAln)
                Next
               
                'Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11), _
                            Array(TmpDz) 'Mid(DzStr(x), dzBoyt(y, 1), dzBoyt(y, 2))
                 Next x
        Next f
    End If
End With
SonStr = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row + 1
xRs.MoveFirst
sht.Range("A" & SonStr).CopyFromRecordset xRs

    s.Close
    Debug.Print "stream", Timer - t1
    MsgBox "işlem tamam"
End Sub

[halily]

dosyanızda ayraç olmadığı için verilerin sabit uzunlukta veri olduğu varsayılmıştır

[halily]

daha hızlı gibi

Kod: Tümünü seç

Sub VeriAlADOTpl_2()
t1 = MicroTimer
AnaKlsr = ThisWorkbook.Path & "\DATA\"

Dim dzBoyt As Variant
ReDim dzBoyt(1 To 12, 1 To 2)
         dzBoyt(1, 1) = 1:   dzBoyt(1, 2) = 10
         dzBoyt(2, 1) = 12:  dzBoyt(2, 2) = 8
         dzBoyt(3, 1) = 21:  dzBoyt(3, 2) = 31
         dzBoyt(4, 1) = 52:  dzBoyt(4, 2) = 8
         dzBoyt(5, 1) = 59:  dzBoyt(5, 2) = 10
         dzBoyt(6, 1) = 68:  dzBoyt(6, 2) = 12
         dzBoyt(7, 1) = 79:  dzBoyt(7, 2) = 8
         dzBoyt(8, 1) = 86:  dzBoyt(8, 2) = 6
         dzBoyt(9, 1) = 91:  dzBoyt(9, 2) = 10
        dzBoyt(10, 1) = 101: dzBoyt(10, 2) = 3
        dzBoyt(11, 1) = 103: dzBoyt(11, 2) = 4
        dzBoyt(12, 1) = 106: dzBoyt(12, 2) = 10


Dim s As Object ' ADODB.Stream
Set s = CreateObject("adodb.Stream")
    s.Charset = "ISO-8859-9" '"utf-8"
    s.Open
     Set FSO = CreateObject("Scripting.FileSystemObject")
Set xRs = CreateObject("ADODB.Recordset")
With xRs
    For Aln = 1 To 12
        .Fields.Append "Aln" & Aln - 1, 8
    Next
    .Open
End With
With FSO
    Set sht = ThisWorkbook.Sheets("sayfa2")
'        sht.Cells.Clear
    If .FolderExists(AnaKlsr) Then
        For Each f In .GetFolder(AnaKlsr).Files
'        Debug.Print f
            s.LoadFromFile (f)
            Dim txt As String
            txt = s.ReadText
            DzStr = Split(txt, vbNewLine)
                 For x = 2 To UBound(DzStr)
                xRs.AddNew Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11), _
                           Array(Mid(DzStr(x), dzBoyt(1, 1), dzBoyt(1, 2)) & " ", _
                                 Mid(DzStr(x), dzBoyt(2, 1), dzBoyt(2, 2)) & " ", _
                                 Mid(DzStr(x), dzBoyt(3, 1), dzBoyt(3, 2)) & " ", _
                                 Mid(DzStr(x), dzBoyt(4, 1), dzBoyt(4, 2)) & " ", _
                                 Mid(DzStr(x), dzBoyt(5, 1), dzBoyt(5, 2)) & " ", _
                                 Mid(DzStr(x), dzBoyt(6, 1), dzBoyt(6, 2)) & " ", _
                                 Mid(DzStr(x), dzBoyt(7, 1), dzBoyt(7, 2)) & " ", _
                                 Mid(DzStr(x), dzBoyt(8, 1), dzBoyt(8, 2)) & " ", _
                                 Mid(DzStr(x), dzBoyt(9, 1), dzBoyt(9, 2)) & " ", _
                                 Mid(DzStr(x), dzBoyt(10, 1), dzBoyt(10, 2)) & " ", _
                                 Mid(DzStr(x), dzBoyt(11, 1), dzBoyt(11, 2)) & " ", _
                                 Mid(DzStr(x), dzBoyt(12, 1), dzBoyt(12, 2)) & " ")
                 Next x
        Next f
    End If
End With
SonStr = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row + 1
xRs.MoveFirst
sht.Range("A" & SonStr).CopyFromRecordset xRs

    s.Close
    Debug.Print "VeriAlADOTp_2", (MicroTimer - t1) * 1000
    MsgBox "işlem tamam"
End Sub

[bozkurt43]

yardımız için teşekkürler peki tuş atamasında başlangıça sayfayı temizle koysam yeni veri geldiğinde tekrar listelese bu şekil yapmak çok mu kasar çünkü şuan yeni dosya eklediğimde algılamıyor

[bozkurt43]

yardımız için teşekkürler peki tuş atamasında başlangıça sayfayı temizle koysam yeni veri geldiğinde tekrar listelese bu şekil yapmak çok mu kasar çünkü şuan yeni dosya eklediğimde algılamıyor

bir sorunda şu dosya içerisinde çok fazla veri var günlük 2 tane den 8 yıllık txt dosyası o yüzden excel kitlendi bu txt dosyalarını seçtirme imkanı var mı

[halily]

sorunuzu tam olarak anlamdım dün defalarca denedim verileri sorunsuz aldı
belirttiğim gibi tüm dosyalar aynı dizindeki DATA klasöründe olmalı
her defasında sayfayı sıfırlayıp eklemek için
With FSO
Set sht = ThisWorkbook.Sheets("sayfa2")
' sht.Cells.Clear
yukardaki kodda yer alan ' sht.Cells.Clear satırının başındaki tek tırnağı kaldırabilirsiniz
dosya seçmeyle ilgili olarak da keşke en başından belirtseydiniz kodu ona göre hazırlardık

[bozkurt43]

sorunuzu tam olarak anlamdım dün defalarca denedim verileri sorunsuz aldı
belirttiğim gibi tüm dosyalar aynı dizindeki DATA klasöründe olmalı
her defasında sayfayı sıfırlayıp eklemek için
With FSO
Set sht = ThisWorkbook.Sheets("sayfa2")
' sht.Cells.Clear
yukardaki kodda yer alan ' sht.Cells.Clear satırının başındaki tek tırnağı kaldırabilirsiniz
dosya seçmeyle ilgili olarak da keşke en başından belirtseydiniz kodu ona göre hazırlardık

Çok teşekkürler bunun üzerinden giderim bir şekil amatör olarak uğraşıyorum akaryakıt istasyon çalıştırıyorum bu şekilde otomasyon dosyalarını excele direk aktarıyorum pompacılar için kendi uğraşlarımla vba formlar ile bir cari program yaptım veresiye ve vardiye hesap programı kodları toplama yazdım kasıyor fln ama öğrendikçe birşeyler yapmaya çalışıyorum keşke sizler kadar olsak ellerinize sağlık