Страницы: 1
RSS
Выгрузка данных из Excel в несколько txt-файлов.
 
Доброй ночи!
Есть рабочий макрос, выгружающий данные в txt-файл:
Код
Sub WriteSERVICE(control As IRibbonControl)
    Dim rowsDict As Object, wsUnload As Worksheet
    Dim s As String, ss As String, j As Long, n As Long
     
    Set wsUnload = ActiveSheet
    Set rowsDict = CreateObject("Scripting.Dictionary")
    If wsUnload.Cells(wsUnload.Rows.Count, 7).Value <> "" Then n = wsUnload.Rows.Count Else n = wsUnload.Cells(wsUnload.Rows.Count, 7).End(xlUp).Row
    For j = 5 To n
        If Not rowsDict.Exists(wsUnload.Cells(j, 4).Value) Then
            rowsDict.Add wsUnload.Cells(j, 4).Value, wsUnload.Cells(j, 4).Value
            s = s & "[InstanceData]" & vbCrLf & "SERVICE=" & wsUnload.Cells(j, 4).Value & vbCrLf & vbCrLf
        End If
    Next j
    
    ss = ThisWorkbook.Path & Application.PathSeparator & Cells(3, 2) & "_" & Format(Now, "dd-mm-yy-hh-mm-ss") & "_SERVICE" & ".txt"
    Open ss For Output As #1
    Print #1, s
    Close #1
    MsgBox "Файл сформирован: " & ss, 64, "Excel"
End Sub
Подскажите, как его модифицировать, чтобы появилась возможность разделения выгрузки данных, по отдельным файлам, прописанных с дополнительном столбце пути файла и его имени?
 
Цитата
jeka-irbis написал:
прописанных с дополнительном столбце
Где этот столбец?
 
Вы это имели ввиду ?
Код
Sub WriteSERVICE(control As IRibbonControl)
    '...
    Next
    
    Dim dostup$
    dostup = Trim(InputBox("Pozhaluysta, vvedite bukvu stolbtsa s putem k katalogu", "Put' k faylam", "B"))
    If dostup = "" Then Exit Sub
    
    ss = ThisWorkbook.Path & Application.PathSeparator
    ss = ss & Cells(3, dostup).Value & "_" & Format(Now, "dd-mm-yy-hh-mm-ss") & "_SERVICE" & ".txt"
    
    n = FreeFile
    Open ss For Output As #n
    Print #n, s
    Close #n
    '...
End Sub


пс:
Код
Set wsUnload = ActiveSheet
Нужно ли это? Через несколько строк у вас есть это (без 'ActiveSheet' ... и без '.Value' тоже):
Код
& Cells(3, 2) &
далее
Код
wsUnload.Cells(wsUnload.Rows.Count, 7).Value
Последняя ячейка столбца "G" ("G65536" или "G1048576"), почему и зачем ?
Код
wsUnload.Rows.Count
Все строки листа, почему и зачем ?
Изменено: ocet p - 08.12.2019 03:23:49
 
ocet p, спасибо за помощь! Вопрос в общем решил сам, пока не было Интернета и возможности прочитать ваш ответ)) Оказалось, достаточно подправить строку 15
Цитата
ss = ThisWorkbook.Path & Application.PathSeparator & Cells(3, 2) & "_" & Format(Now, "dd-mm-yy-hh-mm-ss") & "_SERVICE" & ".txt"
на
Цитата
ss = ThisWorkbook.Path & Application.PathSeparator & Cells(j, 14) & "_" & Format(Now, "dd-mm-yy-hh-mm-ss") & "_SERVICE" & ".txt"
И затем строки 15-18 перенести в цикл, ну и для для красоты изменить строку 19).
Цитата
ocet p написал:
пс:
Я не спец в макросах, вероятно, либо в исходнике было другое, либо я что добавлял в меру своего дилетанства. Макрос - смесь бульдога с носорогом, но работает и за его красотой не следил).
Без
Код
Set wsUnload = ActiveSheet
не работает, выдает ошибку 91.
По другим вопросам - "так было в исходнике".

Итоговый макрос:

Код
Sub WriteSERVICE()
    Dim rowsDict As Object, wsUnload As Worksheet
    Dim s As String, ss As String, j As Long, n As Long
      
    Set wsUnload = ActiveSheet
    Set rowsDict = CreateObject("Scripting.Dictionary")
    If wsUnload.Cells(wsUnload.Rows.Count, 14).Value <> "" Then n = wsUnload.Rows.Count Else n = wsUnload.Cells(wsUnload.Rows.Count, 14).End(xlUp).Row
    For j = 3 To n
        If Not rowsDict.Exists(wsUnload.Cells(j, 4).Value) Then
            rowsDict.Add wsUnload.Cells(j, 4).Value, wsUnload.Cells(j, 4).Value
            s = s & "[InstanceData]" & vbCrLf & "SERVICE=" & wsUnload.Cells(j, 4).Value & vbCrLf & vbCrLf
        End If
             
    ss = ThisWorkbook.Path & Application.PathSeparator & Cells(j, 14) & "_" & Format(Now, "dd-mm-yy-hh-mm-ss") & "_SERVICE" & ".txt"
    Open ss For Output As #1
    Print #1, s
    Close #1
    Next j

    MsgBox "Файл(ы) сформирован(ы)", 64, "Excel"
End Sub
Но обнаружил косяк - как-то нужно сбрасывать переменную "s"...
------------------------------------------------------------------------------------
Юрий М, прошу прощения, не указал, что столбец находится на этом же листе.
Изменено: jeka-irbis - 08.12.2019 21:14:53
 
Я о том, что у нас ни у кого нет Вашего файла.
 
jeka-irbis,
Я в теме "Проверка и формирование уникальных значений ячеек столбца таблицы" добавил
вариант с формулой, вы видели?
 
Юрий М,прикладываю пример.

Kuzmich, да, еще раз спасибо за решение!
 
И все-таки, подскажите, пожалуйста, что нужно в макросе поправить...
Чтобы данные из столбца 8 (H) записывались в разные файлы (столбец 14, N). Данные в каждом файле не должны повторяться (например, в первый файл 461.21.003.txt должно попадать только одно значение DF)
Изменено: jeka-irbis - 09.12.2019 21:20:50
Страницы: 1
Наверх