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

[VBA Excel] Edycja makra - kilka pytań.

05 Maj 2010 12:14 2866 3
  • Poziom 12  
    Witam serdecznie.
    Potrzebuje przerobić pewne makro, z dużą częścią przeróbek już sobie poradziłem i wszystko działa tak jak potrzeba jednak potrzebuję zwiększyć funkcjonalność tego makra. Mianowicie makro wczytuje dane z plików tekstowych za pomocą kreatora importu tekstu ;( chciał bym zrobić tak aby makro działało w pętli i po uruchomieniu przeliczyło wszystkie pliki które znajdują się wraz z nim w katalogu. Makro zapisuje pliki do innego katalogi w excelowskim formacie.

    Pliki źródłowe mają następujące nazwy rok-miesiąc-dzień.txt jednak dane z pewnych przyczyn mogą być niekompletne gdyż parę dni było uszkodzonych.

    Chciał bym aby dane wczytywane były automatyczne tzn. żeby za każdym razem nie trzeba było wybierać spacji jako tabulatora :)

    Był bym wdzięczy jeżeli ktoś by mi pomógł z dopisaniem tej pętli i dopisaniem części odpowiedzialnej za wczytywanie pliku.

    Pozdrawiam :)
  • Pomocny post
    Poziom 13  
    Tak na szybko... Bez obsługi błędów, gładzenia kodu itp.

    Code:
    Sub czytajpliki()
    
    Dim linia, sciezka, fs As Object, f, f2, k
    'Application.ScreenUpdating = False
    sciezka = "C:\Documents and Settings\admin\Desktop\test\"
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(sciezka).Files

    For Each f2 In f
        If Right(f2, 3) = "txt" Then
            Workbooks.OpenText Filename:=f2, Origin _
                :=852, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote _
                , ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, Comma:=False _
                , Space:=True, Other:=False, TrailingMinusNumbers:=True
            ActiveWorkbook.SaveAs Filename:= _
                Left(f2, Len(f2) - 3) & "xls", _
                FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
                ReadOnlyRecommended:=False, CreateBackup:=False
            ActiveWorkbook.Close
        End If
    Next
    'Application.ScreenUpdating = True
    End Subp


    Jeżeli denerwuje cię mrugający ekran to usuń apostrofy sprzed Application.ScreenUpdating.
  • Moderator Programowanie
    Proszę, zgodnie z regulaminem pkt 11.1, o usunięcie słowa POMOC z tytułu.
  • Poziom 12  
    Dziękuję za pomoc. Tak na szybko sprawdzone i wywala mi błąd.. tzn coś nie tak z TrailingMinusNumbers:=True, jutro sobie posiedzę i się pobawię może uda się odpalić :)

    edit

    zmieniłem na :
    Code:
    Workbooks.OpenText Filename:=f2, Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, Comma:=False, Space:=True, Other:=False ', TrailingMinusNumbers:=True
    
           

    i działa :)
    jeszcze raz dziękuje na pomoc :)