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

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

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

P.S. И вот чего бухгалтерам CSV-формат через табулятор не нравится? Или сразу XML...
...
Рейтинг: 0 / 0
Макрос на экспорт из excel в txt
    #38211900
Akel
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Да, сорри на VBA.
далее файл будет отправлен в другую базу через загрузчик и который читает текстовик только по тем правилам которые я описал выше, стандартными средствами экспорта Excel мне не удалось добиться данного результата (не в 2010, не в 2013).
...
Рейтинг: 0 / 0
Макрос на экспорт из excel в txt
    #38212067
скукотища
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
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
Макрос на экспорт из excel в txt
    #38212239
Akel
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Огромное спасибо!
...
Рейтинг: 0 / 0
Макрос на экспорт из excel в txt
    #38212424
Фотография AndreTM
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
скукотища,

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

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


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