Excel Forum - Porady, Pomoc,  Excel Help, Excel FAQ Strona Główna
 FAQ  RegulaminRegulamin  Szukaj   Użytkownicy   Grupy   Rejestracja   Profil   Twoje wiadomości   Zaloguj 


Poprzedni temat «» Następny temat
ID tematu: 20544 Skopiuj do schowka eksport do pliku *.txt rozdzielonego przecinkami
Autor Wiadomość
Betinka
[Usunięty]

Wysłany: 07-02-2011, 07:52   eksport do pliku *.txt rozdzielonego przecinkami

cześć,

Mam problem z makrem zapisanym w załączonym arkuszu pod nazwą START.
Makro ma za zadanie eksportować dane z arkusza do pliku txt oddzielając kolumny przecinkami.
Makro znalazłam na tym forum i nie znam się w ogóle na VBA. Wiem jednak że makro nie robi dokładnie tego czego chce, np:
1)puste wiersze excela zamienia na ",,," zamiast na pusty wiersz pliku txt
2)na końcu prawie każdego wiersza dodaje niepotrzebnie ",,,"
3)niektóre linijki ucina np. 14,16,18 itd

Załączam plik źródłowy excela i wynikowy txt dla lepszego zobrazowania.

Czy ktoś wie dlaczego makro nie działa jak należy?

dziękuje
Beata



zamiana na plik txt z przecinkami.rar
Pobierz Plik ściągnięto 150 raz(y) 27.2 KB

ID posta: 108075 Skopiuj do schowka
 
 
tkuchta1 
Excel Expert



Pomógł: 1749 razy
Posty: 2888
Wysłany: 07-02-2011, 09:02   

Plik TXT tworzysz sposobem nr.1 linijką TBL2TXT_VBA .Range("A1:D" & ostAD), strTXTFile

Chciałbym zwrócić uwagę że export do pliku txt ma być przeprowadzony w taki sposbó żeby istniał sposób importu z takiego txt zapewniający dokładne odtworzenie danych, ich układu, formatowania ....

Ad.1 (puste wiersze)
zapis ,,,,, to żeczywiście pusty wiersz. Twierdzenie że zapis jest nieprawidłowy uważam za niezasadne właśnie z powodu problemu z odtworzeniem pierwotnego układu danych. Jeżeli jednak pusty wiersz Ci nie pasuje to usuń go z zakresu wchodzącego w zakres vDane

Ad.2 (koniec wiersza ,,,)
To również nie jest błąd :-) Oznacz to że kolejne kolumny były puste. Ale nie zawsze tak musi być i żeby import wiedział w którą kolumnę umieścić dane potrzeben są te włąsnie separatory. Np:
masz dane:
Kod:
---A----B----C--
1  1   
2       2 
3            3


zapis powienien wyglądać tak:
1,,
,2,
,,3
bo taki zapis pozwoli na poprawny import takiefo txt pozwalający na odtworzenie pierwotnego układu danych

Ad.3 (ucina linijki)
Zauważ w wyżej cytowanej linijce jaki zakres jest zapisywany do txt: "A1:D" & ostAD
to może u siebie zmień na G ;-)


Sprawdź
Kod:
Option Explicit

Sub Start()
    Dim strTXTFile As String
    Dim xlWks As Excel.Worksheet, ostAD As Long
   
    strTXTFile = ThisWorkbook.Path & "\temp.txt"
   
    Set xlWks = ThisWorkbook.Worksheets("Arkusz1")
    With xlWks
        ostAD = Last(.Columns("A:D"))
        If ostAD > 1 Then
            Tbl2TXT_FSO .Range("A1:G" & ostAD), strTXTFile
            MsgBox "Już :-)" & String(2, vbCrLf) & strTXTFile, vbInformation
        End If
    End With
   
    Set xlWks = Nothing
End Sub

Sub Tbl2TXT_FSO(vDane As Variant, _
                strTXTFileFullName As String)

    Dim objFSO As Object ' Scripting.FileSystemObject
    Dim objStream As Object ' Scripting.TextStream
    Const ForWriting = 2
   
    Dim tbl As Variant
    Dim i As Long, j As Integer
    Dim strLine As String
    Const strSep As String = ","

    tbl = vDane

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objStream = objFSO.OpenTextFile(Filename:=strTXTFileFullName, _
                                        IOMode:=ForWriting, _
                                        Create:=True)
    With objStream
        For i = LBound(tbl, 1) To UBound(tbl, 1)
            For j = LBound(tbl, 2) To UBound(tbl, 2)
                strLine = strLine & tbl(i, j) & strSep
            Next
            strLine = Left(strLine, Len(strLine) - Len(strSep))
            Do While Right(strLine, 1) = strSep
                strLine = Left(strLine, Len(strLine) - Len(strSep))
            Loop
            .WriteLine Text:=strLine
            strLine = vbNullString
        Next
        .Close
    End With
   
    Set objStream = Nothing
    Set objFSO = Nothing
End Sub

Function Last(rng As Excel.Range) As Long
' wg. Ron de Bruin, 20 Feb 2007
' http://www.rondebruin.nl/last.htm
    On Error Resume Next
    Last = rng.Find(What:="*", _
                    After:=rng.Cells(1), _
                    Lookat:=xlPart, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlPrevious, _
                    MatchCase:=False).Row
    On Error GoTo 0
End Function

_________________
Tomek



Moja Stronka
APoCoTenExcel
Ostatnia aktualizacja: 2015-09-04
ID posta: 108081 Skopiuj do schowka
 
 
Betinka
[Usunięty]

Wysłany: 07-02-2011, 09:53   

hej,
wygląda na to że wszystko teraz jest OK - jeszcze potestuje ;-)

dzięki za dostosowanie kodu pod moje potrzeby!

PS:
czyli żeby zmienić zakres kolumn na A:ZZ muszę tylko zmienić tu:
Kod:
Tbl2TXT_FSO .Range("A1:G" & ostAD), strTXTFile

na
Kod:
Tbl2TXT_FSO .Range("A1:ZZ" & ostAD), strTXTFile


czy jeszcze tutaj:
Kod:
ostAD = Last(.Columns("A:D"))

na
Kod:
ostAD = Last(.Columns("A:ZZ"))
ID posta: 108083 Skopiuj do schowka
 
 
Wyświetl posty z ostatnich:   
Odpowiedz do tematu
Nie możesz pisać nowych tematów
Nie możesz odpowiadać w tematach
Nie możesz zmieniać swoich postów
Nie możesz usuwać swoich postów
Nie możesz głosować w ankietach
Nie możesz załączać plików na tym forum
Możesz ściągać załączniki na tym forum
Dodaj temat do Ulubionych
Wersja do druku

Skocz do:  

Powered by phpBB modified by Przemo © 2003 phpBB Group
Theme xandgreen created by spleen& Programosy modified v0.3 by warna
Opieka techniczna www.marketingNET.pl

Archiwum

Strona używa plików cookies.

Kliknij tutaj, żeby dowiedzieć się jaki jest cel używania cookies oraz jak zmienić ustawienia cookie w przeglądarce.
Korzystając ze strony użytkownik wyraża zgodę na używanie plików cookies, zgodnie z bieżącymi ustawieniami przeglądarki.
Sprawdź, w jaki sposób przetwarzamy dane osobowe