[Yardım]  DOSYADAN VERİ ALMA YARDIM

VBA Makrolar ile ilgili sormak istedikleriniz, yapmak istedikleriniz hakkında yardım alabileceğiniz bölümdür.

DOSYADAN VERİ ALMA YARDIM

İleti#1)  bozkurt43 » 27 Tem 2022 13:46

ö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
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
bozkurt43
 
Kayıt: 13 Tem 2022 18:29
Meslek: MÜHENDİS
Yaş: 29
İleti: 5
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: kütahya

Yıllık Maaş Bordrosu Hesaplama 2022

Cevap: DOSYADAN VERİ ALMA YARDIM

İleti#2)  dogankarun » 27 Tem 2022 16:37

Merhabalar,
"Veri - Metni Sütunlara Dönüştür" denediniz mi?
Kullanıcı avatarı
dogankarun
Yeni Başlamış
 
Kayıt: 01 Arl 2017 10:58
Meslek: Tıbbi Sekreter
Yaş: 37
İleti: 16
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: KONYA / Karatay

Cevap: DOSYADAN VERİ ALMA YARDIM

İleti#3)  bozkurt43 » 27 Tem 2022 17:47

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
Kullanıcı avatarı
bozkurt43
 
Kayıt: 13 Tem 2022 18:29
Meslek: MÜHENDİS
Yaş: 29
İleti: 5
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: kütahya

Cevap: Cevap: DOSYADAN VERİ ALMA YARDIM

İleti#4)  dogankarun » 27 Tem 2022 17:54

bozkurt43 yazdı: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.
Kullanıcı avatarı
dogankarun
Yeni Başlamış
 
Kayıt: 01 Arl 2017 10:58
Meslek: Tıbbi Sekreter
Yaş: 37
İleti: 16
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: KONYA / Karatay

REKLAM
Excel Logo XML Oluşturucu
Logo Object Designer ile Uyarlama

Cevap: DOSYADAN VERİ ALMA YARDIM

İleti#5)  halily » 27 Tem 2022 19:22

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
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
halily
Site Dostu
 
Kayıt: 23 May 2019 13:16
Meslek: yok
Yaş: 42
İleti: 957
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: adana

Cevap: DOSYADAN VERİ ALMA YARDIM

İleti#6)  halily » 27 Tem 2022 19:24

dosyanızda ayraç olmadığı için verilerin sabit uzunlukta veri olduğu varsayılmıştır
Kullanıcı avatarı
halily
Site Dostu
 
Kayıt: 23 May 2019 13:16
Meslek: yok
Yaş: 42
İleti: 957
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: adana

REKLAM
ETA - Excel Konsolide Raporlama
ETA Excel Personel Entegre Raporu

Cevap: DOSYADAN VERİ ALMA YARDIM

İleti#7)  halily » 27 Tem 2022 21:02

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
Kullanıcı avatarı
halily
Site Dostu
 
Kayıt: 23 May 2019 13:16
Meslek: yok
Yaş: 42
İleti: 957
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: adana

Cevap: DOSYADAN VERİ ALMA YARDIM

İleti#8)  bozkurt43 » 28 Tem 2022 12:49

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
Kullanıcı avatarı
bozkurt43
 
Kayıt: 13 Tem 2022 18:29
Meslek: MÜHENDİS
Yaş: 29
İleti: 5
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: kütahya

Cevap: Cevap: DOSYADAN VERİ ALMA YARDIM

İleti#9)  bozkurt43 » 28 Tem 2022 13:05

bozkurt43 yazdı: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ı :D o yüzden excel kitlendi :D bu txt dosyalarını seçtirme imkanı var mı
Kullanıcı avatarı
bozkurt43
 
Kayıt: 13 Tem 2022 18:29
Meslek: MÜHENDİS
Yaş: 29
İleti: 5
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: kütahya

Cevap: DOSYADAN VERİ ALMA YARDIM

İleti#10)  halily » 28 Tem 2022 13:20

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
Kullanıcı avatarı
halily
Site Dostu
 
Kayıt: 23 May 2019 13:16
Meslek: yok
Yaş: 42
İleti: 957
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: adana

Cevap: Cevap: DOSYADAN VERİ ALMA YARDIM

İleti#11)  bozkurt43 » 28 Tem 2022 13:41

halily yazdı: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
Kullanıcı avatarı
bozkurt43
 
Kayıt: 13 Tem 2022 18:29
Meslek: MÜHENDİS
Yaş: 29
İleti: 5
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: kütahya


Forum Genel Makro Soruları

Online Kullanıcılar

Bu forumu görüntüleyenler: Kayıtlı kullanıcı yok ve 8 misafir

Bumerang - Yazarkafe