Elektroda.pl
Elektroda.pl
X
Proszę, dodaj wyjątek www.elektroda.pl do Adblock.
Dzięki temu, że oglądasz reklamy, wspierasz portal i użytkowników.

Excel - Pobieranie danych z plików txt do arkusza

akrtodifi 08 Sty 2014 23:06 2313 20
  • #1 08 Sty 2014 23:06
    akrtodifi
    Poziom 6  

    Dzień dobry.
    Jestem kompletnie zielony w programowaniu VBA.

    Potrzebuje dokonać importu danych z kilkuset plików .txt. Z pojedynczym nie mam problemu, ale chciałbym zautomatyzować cały proces.

    Excel pobiera z pliku .txt dane do arkusza oraz zmienia jego nazwę (arkusza) na taką samą co plik z którego dane zostały pobrane. (Name,Date,Open,High,Low,Close,Volume + niżej dane)

    i tak zapętlone.

    Proszę o pomoc.

    0 20
  • Pomocny post
    #2 09 Sty 2014 03:31
    PRL
    Poziom 34  

    Kod: vb
    Zaloguj się, aby zobaczyć kod

    0
  • #3 09 Sty 2014 14:52
    akrtodifi
    Poziom 6  

    Code:
    Sub Importuj()
    
    Dim Plik As String
    Plik = Dir("D:\praca\notowania\omegancn\*.txt")
    Do While Plik <> ""
            With ActiveSheet.QueryTables.Add(Connection:= _
            "TEXT;D:\notowania\omegancn\01CYBATON.txt", Destination:=Range("$A$1"))
            .Name = "01CYBATON"
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 852
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = True
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = True
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(1, 5, 1, 1, 1, 1, 1)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With
        Plik = Dir
    Loop
    End Sub

    Sub Makro1()
    '
    ' Makro1 Makro
    '

    '

    End Sub


    Mógłbym prosić o połączenie tego kodu z tym powyżej?
    Przydałaby się także alternatywa dla zapisu do nowego arkusza, z zapisem do nowego pliku(skoroszytu) również z nazwą tak jak plik txt.

    0
  • Pomocny post
    #4 09 Sty 2014 15:01
    PRL
    Poziom 34  

    Kod: vb
    Zaloguj się, aby zobaczyć kod


    D:\Notowania, czy D:\Praca\Notowania?

    Zdecyduj się.;)

    0
  • #5 09 Sty 2014 15:38
    akrtodifi
    Poziom 6  

    D:\Notowania

    :)

    Dodano po 34 [minuty]:

    PRL Wszystko super działa tylko chciałbym żeby w pierwszym wariancie dane importowało do nowego arkusza z nazwa pliku, w drugim natomiast do zupełnie nowego skoroszytu (pliku excel) również z nazwą pliku z którego dane zostały importowane.

    0
  • #6 09 Sty 2014 15:59
    PRL
    Poziom 34  

    Nagraj makro i popraw według potrzeb.
    Wybacz, ale apetyt rośnie w miarę jedzenia...
    Daj coś z siebie.

    0
  • #7 09 Sty 2014 19:33
    akrtodifi
    Poziom 6  

    Siedzę, czytam ale nie daje rady.

    Code:

    Sub Importuj()
    Dim Plik As String
    Plik = Dir("D:\praca\notowania\omegancn\*.txt")
    Do While Plik <> ""
            With ActiveSheet.QueryTables.Add(Connection:= _
            "TEXT;D:\praca\notowania\omegancn\" & Plik, Destination:=Range("$A$1"))
            .Name = Plik
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 852
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = True
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = True
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(1, 5, 1, 1, 1, 1, 1)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False

        End With
        Plik = Dir
     

    Loop
    End Sub



    Pomógłby ktoś aby importowanie plików odbywało się do nowego arkusza o nazwie pliku z którego pobrano dane?
    Aktualnie wszystko jest w jednym arkuszu i jest to strasznie nieczytelne.
    Nazwa nowego arkusza to także pozycja A2

    0
  • #8 09 Sty 2014 20:17
    adamas_nt
    Moderator Programowanie

    Pomyśl, jak radzi kolega PRL. Przecież jeśli wstawiasz kwerendę

    Cytat:
    With ActiveSheet.QueryTables.Add(Conne...
    to wystarczy jak na początku pętli dopiszesz wstawianie nowego arkusza (nagraj makro i przekopiuj), nadanie mu nazwy i aktywowanie (niekonieczne, bo nowy=aktywowany, ale dla porządku). Razem 3 (słownie: trzy) linijki ;)

    Pomocna uwaga: Nowo wstawiony arkusz ma zawsze najwyższy indeks. Odwołanie do niego (Np przy zmianie nazwy): Sheets(sheets.Count).Name="NowaNazwa"

    0
  • #9 10 Sty 2014 05:10
    PRL
    Poziom 34  

    Kod: vb
    Zaloguj się, aby zobaczyć kod


    Ponawiam pytanie odnośnie ścieżki do plików z danymi wejściowymi.
    Raz jest D:\Notowania, a innym razem D:\Praca\Notowania...

    0
  • Pomocny post
    #10 10 Sty 2014 10:23
    markoz7874
    Poziom 31  

    PRL napisał:
    ..
    Ponawiam pytanie odnośnie ścieżki do plików z danymi wejściowymi.
    Raz jest D:\Notowania, a innym razem D:\Praca\Notowania...

    Tak długo jak założyciel wątku nie będzie się skupiał na tym co robi, żadna pomoc nie ma sensu.
    Druga sprawa, to używanie zmiennych. Jak się już zmienną tworzy, to może warto jej używać a nie w jednym miejscu używa zmiennej, innym razem ścieżkę wpisuje "z ręki"

    0
  • #12 11 Sty 2014 11:01
    markoz7874
    Poziom 31  

    PRL napisał:
    I co, już po problemie?;)

    Zadałeś za trudne pytanie ;)

    0
  • #13 11 Sty 2014 11:40
    akrtodifi
    Poziom 6  

    Jak zrobić odwołanie do arkusza w innym skoroszycie_2 gdzie nazwa arkusza to pozycja "A2" ze skoroszytu_1?

    Code:
    =[skoroszyt2.xlsx]nazwa_arkusza!$E$5


    nazwa_arkusza = pozycja A2 z dowolnego arkusza skoroszytu_1

    0
  • Pomocny post
    #14 11 Sty 2014 12:05
    markoz7874
    Poziom 31  

    akrtodifi napisał:
    Jak zrobić odwołanie do arkusza w innym skoroszycie_2 gdzie nazwa arkusza to pozycja "A2" ze skoroszytu_1?
    Code:
    =[skoroszyt2.xlsx]nazwa_arkusza!$E$5


    nazwa_arkusza = pozycja A2 z dowolnego arkusza skoroszytu_1

    Użyj funkcji
    Kod: vb
    Zaloguj się, aby zobaczyć kod


    A dokładniej
    Kod: vb
    Zaloguj się, aby zobaczyć kod

    0
  • #15 12 Sty 2014 16:50
    akrtodifi
    Poziom 6  

    Code:
    =WYSZUKAJ.PIONOWO(D14;(ADR.POŚR("[notowania.xlsx]"&B14&"!"&Parametry!$B$1));5;0)

    istnieje możliwość dodania warunku, który wyszuka najbliższą mniejszą wartość jeżeli nie znajdzie wartości z D14?

    0
  • Pomocny post
    #16 12 Sty 2014 16:56
    PRL
    Poziom 34  

    Istniej możliwość, że w jakiś sposób pokażesz, że nie masz w d. pomagających Tobie osób?
    Jak dotąd tylko pytasz i masz gdzieś, że Ci pomagają.
    Elektroda, to ludzie, a nie tylko serwer z wyszukiwarką.

    0
  • #17 12 Sty 2014 17:19
    markoz7874
    Poziom 31  

    akrtodifi napisał:
    Code:
    =WYSZUKAJ.PIONOWO(D14;(ADR.POŚR("[notowania.xlsx]"&B14&"!"&Parametry!$B$1));5;0)

    istnieje możliwość dodania warunku, który wyszuka najbliższą mniejszą wartość jeżeli nie znajdzie wartości z D14?

    Konkretna odpowiedz na tak konkretnie postawione pytanie brzmi:
    Istnieje :)

    Kolega PRL delikatnie sugeruje, że jeżeli nasze informacje są Tobie pomocne, wypadało by wcisnąć przycisk "pomógł" ;)
    To dla nas informacja zwrotna, że doceniono nasze skromne wysiłki i warto się produkować w Twoim wątku :)

    0
  • #18 12 Sty 2014 17:20
    akrtodifi
    Poziom 6  

    Dziękuję bardzo za wcześniejszą pomoc i przepraszam za swoje zachowanie. Bardzo mi pomogliście!

    0
  • #19 12 Sty 2014 17:33
    PRL
    Poziom 34  

    Cytat:
    Kolega PRL delikatnie sugeruje,


    że jest starej daty i jego Tata uczył go, że kultura wymaga podziękowania za pomoc.:)

    0
  • #20 12 Sty 2014 19:21
    markoz7874
    Poziom 31  

    akrtodifi napisał:
    Code:
    =WYSZUKAJ.PIONOWO(D14;(ADR.POŚR("[notowania.xlsx]"&B14&"!"&Parametry!$B$1));5;0)

    istnieje możliwość dodania warunku, który wyszuka najbliższą mniejszą wartość jeżeli nie znajdzie wartości z D14?

    Załącz proszę arkusze na których pracujesz, bardzo niewygodnie jest komuś pomagać, kiedy ten ktoś widzi co ma przed oczami, a pomagający musi się domyślać.

    0
  • #21 12 Sty 2014 20:26
    akrtodifi
    Poziom 6  

    Rozumiem :) Na razie dziękuję za pomoc. Jak coś po drodze mi się wysypie do będę u Was szukał wsparcie. Widzę macie i fajnie, że się nią dzielicie. Pozdrawiam

    0