Гость
Целевая тема:
Создать новую тему:
Автор:
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Макрос на экспорт из excel в txt / 8 сообщений из 8, страница 1 из 1
03.04.2013, 20:13
    #38211841
Akel
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Макрос на экспорт из excel в txt
Всем доброго дня.

Обращаюсь к гуру макросов, т.к. сам уже достаточно давно не общался с VBS и для меня задача оказалось сложной, особенно если учесть выделенное время на ее решение :(
Поступила задачка на создание макроса на экспорт данных excel в txt с определенными правилами, а именно:
1. первый 4 строки экспортировать как есть
2. запись данных таблицы начинать с 5-й строки, при этом данные из столбца "B" начинать записывать с 7 символа, столбца "C" с 20, а последний "0" столбца "D" должен быть 37-м символом
3. последняя строка "Итого" в свободной форме

прикрепил пример исходника для экспорта в xlsx и результат, который должен получиться.
...
Рейтинг: 0 / 0
03.04.2013, 21:04
    #38211879
AndreTM
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Макрос на экспорт из excel в txt
Должно быть писано точно на VBS? Или всё же на VBA?

P.S. И вот чего бухгалтерам CSV-формат через табулятор не нравится? Или сразу XML...
...
Рейтинг: 0 / 0
03.04.2013, 21:39
    #38211900
Akel
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Макрос на экспорт из excel в txt
Да, сорри на VBA.
далее файл будет отправлен в другую базу через загрузчик и который читает текстовик только по тем правилам которые я описал выше, стандартными средствами экспорта Excel мне не удалось добиться данного результата (не в 2010, не в 2013).
...
Рейтинг: 0 / 0
04.04.2013, 02:30
    #38212067
скукотища
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Макрос на экспорт из excel в txt
Akel,
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
Option Explicit
Option Base 0

Sub expToFixedSmart()
    '$conditions
    Const I_HEADER& = 4&, S_FOOTER$ = "Èòîãî:", S_FORMAT$ = "#0.00"
    '$fuse
    Const I_MAX_BLANK& = 3&, I_MAX_ROW& = 1000&
    
    Dim f%, sExpFileName$
    Dim a, s$, s2$, k&, k2&, iLen&
    
    '$datatableconditions
    a = Array(6&, 13&, 37&)
    
    '$expfilename
    sExpFileName = Left$(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1) & "_exp.txt"
    ChDrive Left$(ThisWorkbook.Path, 1)
    ChDir ThisWorkbook.Path
    
    
    f = FreeFile
    Open sExpFileName For Output Access Write As #f
    
    With ThisWorkbook.Worksheets(1)
        '$header
        For k = 1 To I_HEADER
            s = .Cells(k, 1).Value2
            Print #f, s
        Next k
        
        k = I_HEADER + 1: k2 = 0
        
        '$datatable
        Do Until _
            0 = StrComp(S_FOOTER, .Cells(k, 1).Value2) Or _
            I_MAX_ROW < k Or _
            I_MAX_BLANK < k2
            
            iLen = Len(.Cells(k, 1).Value2)
            If iLen > 0 Then
                'col#1
                s = .Cells(k, 1).Value2 & Space(a(0) - iLen)
                
                'col#2
                iLen = Len(.Cells(k, 2).Value2)
                s = s & .Cells(k, 2).Value2 & Space(a(1) - iLen)
                
                'col##3,4
                s = s & .Cells(k, 3): s2 = Format$(.Cells(k, 4), S_FORMAT)
                iLen = Len(s) + Len(s2)
                s = s & Space(a(2) - iLen) & s2
                
                k2 = 0
                
            Else:   s = "": k2 = k2 + 1
            End If
            
            Print #f, s
            k = k + 1
        Loop
        
        '$footer|$err
        If StrComp(S_FOOTER, .Cells(k, 1).Value2) = 0 Then
            s = .Cells(k, 1).Value2 & "  " & Format$(.Cells(k, 4).Value2, S_FORMAT)
        ElseIf I_MAX_BLANK < k2 Then
            s = "E: footer row not found, MAX_BLANK reached"
        Else
            s = "E: footer row not found, MAX_ROW reached"
        End If
        
        Print #f, s
    End With
    
    Close #f
    Shell "notepad " & sExpFileName, vbNormalFocus
    
End Sub

ЗЫ: странно, что на наименование+сумма всего 18 символов...
...
Рейтинг: 0 / 0
04.04.2013, 09:43
    #38212239
Akel
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Макрос на экспорт из excel в txt
Огромное спасибо!
...
Рейтинг: 0 / 0
04.04.2013, 11:12
    #38212424
AndreTM
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Макрос на экспорт из excel в txt
скукотища,

Зачем так было извращаться-то?
Можно же просто сформировать на отдельном листе в первом столбце строки с заголовком и данными в нужном формате (хоть средствами самого Excel), а затем сохранить этот лист как текст...
...
Рейтинг: 0 / 0
04.04.2013, 18:05
    #38213427
скукотища
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Макрос на экспорт из excel в txt
AndreTM скукотища,

Зачем так было извращаться-то?
Можно же просто сформировать на отдельном листе в первом столбце строки с заголовком и данными в нужном формате (хоть средствами самого Excel), а затем сохранить этот лист как текст...
Те-же яй извращения, только в профиль.
...
Рейтинг: 0 / 0
04.04.2013, 18:39
    #38213493
AndreTM
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Макрос на экспорт из excel в txt
скукотищаAndreTM скукотища,
поскипано...Те-же яй извращения, только в профиль.Не спорю
...
Рейтинг: 0 / 0
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Макрос на экспорт из excel в txt / 8 сообщений из 8, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]