Страницы: 1
RSS
Создание файла txt с наименованием из ячейки и копирование в него данных по условию
 
Добрый день!

Подскажите, пожалуйста, каким образом я могу создать файл txt в определенной папке (D:\Test) c наименованием файла, которое соответствует значению в ячейке С3 и скопировать туда выбранные данные из диапазона D6:E18 при условии, что начало диапазона всегда начинается с ячейки D6, а конец диапазона будет динамическим (последняя не пустая ячейка в диапазоне D6:E18). В примере диапазон для копирования будет D6:E12.

С уважением, Dost1369.
 
Код
Sub SaveTextFile()
    Const sPath = "D:\Test"

    Dim sName As String
    sName = Range("C3").Value
    
    Dim yy As Long
    yy = Application.Max(Cells(Rows.Count, [D1].Column).End(xlUp).Row, Cells(Rows.Count, [E1].Column).End(xlUp).Row, 6)
    Dim arr As Variant
    arr = Range(Cells(6, 4), Cells(yy, 5))
    Dim txt As String
    For yy = 1 To UBound(arr, 1)
        txt = txt & arr(yy, 1) & vbTab & arr(yy, 2) & vbCrLf
    Next
    
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FolderExists(sPath) Then fso.CreateFolder sPath & "\"
    With fso.CreateTextFile(sPath & "\" & sName & ".txt", True)
        .Write txt
        .Close
    End With
End Sub
 
Код
Sub CreateTxtFile()
  Dim fs, txt, rg
  Set fs = CreateObject("Scripting.FileSystemObject")
  Set txt = fs.CreateTextFile("d:\Test\" & [c3], True): Set rg = [d6]
  Do While Not IsEmpty(rg)
    txt.WriteLine rg & " " & rg.Offset(0, 1):   Set rg = rg.Offset(1)
  Loop
  txt.Close
End Sub
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Цитата
написал:
Код
    [URL=#]?[/URL]       1  2  3  4  5  6  7  8  9      Sub   CreateTxtFile()        Dim   fs, txt, rg        Set   fs = CreateObject(  "Scripting.FileSystemObject"  )        Set   txt = fs.CreateTextFile("d:\Test\" & [c3],   True  ):   Set   rg = [d6]        Do   While   Not   IsEmpty(rg)          txt.WriteLine rg &   " "   & rg.Offset(0, 1):     Set   rg = rg.Offset(1)        Loop        txt.Close    End   Sub   
 
Добавил еще & ".txt" для создания расширения, все работает. Спасибо.
Но в оригинальном файле есть один нюанс, в ячейки, которые пустые для человека, эксель все-равно видит формулу, которая как раз таки возвращает пустоту.
Это как-то можно обойти или придется ручками удалять из txt?
 
МатросНаЗебре, Что-то по Вашему варианту у меня не получается. Вставлял и в модули и в сами листы.  
 
Код
Sub CreateTxtFile()
  Dim fs, txt, rg
  Set fs = CreateObject("Scripting.FileSystemObject")
  Set txt = fs.CreateTextFile("d:\" & [c3], True)
  For Each rg In Range([d6], Cells(Rows.Count, 4).End(xlUp))
    If Len(rg) Then txt.WriteLine rg & " " & rg.Offset(0, 1)
  Next
  txt.Close
End Sub
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Ігор Гончаренко, Все-равно из столбца D импортирует данные там, где в столбце E пустота.
Ну либо я что-то делаю не так.  :sceptic:  
 
невнятно обьясняете
после обьяснений масса пищи для домыслов
мне по барабану что будет в итоге, пишу как понял
а если вам интересно, то обяснять нужно так, чтобы не было двусмысленности
кстати я леплю пробел между Д и Е а нужен он вам или нет я не знаю
Изменено: Ігор Гончаренко - 09.08.2022 16:09:39
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Цитата
написал:
кстати я леплю пробел между Д и Е а нужен он вам или нет я не знаю
Очень важное уточнение, поправил у себя. Спасибо.
Страницы: 1
Наверх