Vba excel сохранение в текстовый файл
Прошу помочь в доработке макроса, который бы выполнял сохранение выделенного диапазона листа в текстовый документ с разделителями табуляции, желательно также запрашивая новое имя файла (желательно, но не обязательно. будет достаточно указания на директорию сохранения)
Есть следующий макрос:
Sub Txt_Save()
Dim Nam As String
Nam = InputBox(Prompt:="Укажите имя файла", Title:="Выберите имя")
Selection.Copy
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Workbooks.Add
ActiveSheet.Paste
ActiveWorkbook.SaveAs Filename:="D:\" & Nam & ".txt", FileFormat:= _
xlText, CreateBackup:=False
ActiveWorkbook.Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Проблема в том, что в нужном фрагменте присутствуют даты в формате дд.мм.гггг и дд.мм.гг, которые после исполнения макроса меняют формат на м/дд/гг и дд/мм/гг соответственно. Это для меня недопустимо.
Если же я выполняю всю операцию вручную (копирую диапазон, создаю новую книгу, вставляю и сохраняю в нужном формате) таких изменений не происходит и все ОК. Но это несколько неудобно.
Прошу помочь не очень опытному в этом вопросе человеку)
Прошу помочь в доработке макроса, который бы выполнял сохранение выделенного диапазона листа в текстовый документ с разделителями табуляции, желательно также запрашивая новое имя файла (желательно, но не обязательно. будет достаточно указания на директорию сохранения)
Есть следующий макрос:
Sub Txt_Save()
Dim Nam As String
Nam = InputBox(Prompt:="Укажите имя файла", Title:="Выберите имя")
Selection.Copy
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Workbooks.Add
ActiveSheet.Paste
ActiveWorkbook.SaveAs Filename:="D:\" & Nam & ".txt", FileFormat:= _
xlText, CreateBackup:=False
ActiveWorkbook.Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Проблема в том, что в нужном фрагменте присутствуют даты в формате дд.мм.гггг и дд.мм.гг, которые после исполнения макроса меняют формат на м/дд/гг и дд/мм/гг соответственно. Это для меня недопустимо.
Если же я выполняю всю операцию вручную (копирую диапазон, создаю новую книгу, вставляю и сохраняю в нужном формате) таких изменений не происходит и все ОК. Но это несколько неудобно.
Прошу помочь не очень опытному в этом вопросе человеку) Ivar
Прошу помочь в доработке макроса, который бы выполнял сохранение выделенного диапазона листа в текстовый документ с разделителями табуляции, желательно также запрашивая новое имя файла (желательно, но не обязательно. будет достаточно указания на директорию сохранения)
Есть следующий макрос:
Sub Txt_Save()
Dim Nam As String
Nam = InputBox(Prompt:="Укажите имя файла", Title:="Выберите имя")
Selection.Copy
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Workbooks.Add
ActiveSheet.Paste
ActiveWorkbook.SaveAs Filename:="D:\" & Nam & ".txt", FileFormat:= _
xlText, CreateBackup:=False
ActiveWorkbook.Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Проблема в том, что в нужном фрагменте присутствуют даты в формате дд.мм.гггг и дд.мм.гг, которые после исполнения макроса меняют формат на м/дд/гг и дд/мм/гг соответственно. Это для меня недопустимо.
Если же я выполняю всю операцию вручную (копирую диапазон, создаю новую книгу, вставляю и сохраняю в нужном формате) таких изменений не происходит и все ОК. Но это несколько неудобно.
Прошу помочь не очень опытному в этом вопросе человеку) Автор - Ivar
Дата добавления - 09.04.2013 в 10:39
Ответ подсказан человеком с другого ресурса.
в 10-ю строчку требуется добавить
Sub СохранениеВТекст()
'
' СохранениеВТекст Макрос
Dim Namе As String
Namе = InputBox(Prompt:="Введи имя", Title:="Имя")
Selection.Copy
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Workbooks.Add
ActiveSheet.Paste
ActiveWorkbook.SaveAs Filename:="D:\" & Namе & ".txt", FileFormat:= _
xlText, CreateBackup:=False, Local:=True
ActiveWorkbook.Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Ответ подсказан человеком с другого ресурса.
в 10-ю строчку требуется добавить
Sub СохранениеВТекст()
'
' СохранениеВТекст Макрос
Dim Namе As String
Namе = InputBox(Prompt:="Введи имя", Title:="Имя")
Selection.Copy
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Workbooks.Add
ActiveSheet.Paste
ActiveWorkbook.SaveAs Filename:="D:\" & Namе & ".txt", FileFormat:= _
xlText, CreateBackup:=False, Local:=True
ActiveWorkbook.Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
в 10-ю строчку требуется добавить
Sub СохранениеВТекст()
'
' СохранениеВТекст Макрос
Dim Namе As String
Namе = InputBox(Prompt:="Введи имя", Title:="Имя")
Selection.Copy
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Workbooks.Add
ActiveSheet.Paste
ActiveWorkbook.SaveAs Filename:="D:\" & Namе & ".txt", FileFormat:= _
xlText, CreateBackup:=False, Local:=True
ActiveWorkbook.Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Sub IntoTxt()
Dim x, y(), fName$, i&, j&, s$
x = Intersect(ActiveSheet.UsedRange, Selection).Value
If Not IsArray(x) Then Exit Sub
fName = InputBox(Prompt:="Укажите имя файла", Title:="Выберите имя")
If fName = vbNullString Then Exit Sub
ReDim y(1 To UBound(x))
For i = 1 To UBound(x)
For j = 1 To UBound(x, 2)
y(i) = y(i) & x(i, j)
Next j
Next i: s = Join(y, vbCrLf)
'MsgBox "s created" & Len(s)
With CreateObject("scripting.filesystemobject")
With .CreateTextFile("D:\" & fName & ".txt", True)
.Write s: .Close
End With
End With
MsgBox "Ok"
End Sub
Sub IntoTxt()
Dim x, y(), fName$, i&, j&, s$
x = Intersect(ActiveSheet.UsedRange, Selection).Value
If Not IsArray(x) Then Exit Sub
fName = InputBox(Prompt:="Укажите имя файла", Title:="Выберите имя")
If fName = vbNullString Then Exit Sub
ReDim y(1 To UBound(x))
For i = 1 To UBound(x)
For j = 1 To UBound(x, 2)
y(i) = y(i) & x(i, j)
Next j
Next i: s = Join(y, vbCrLf)
'MsgBox "s created" & Len(s)
With CreateObject("scripting.filesystemobject")
With .CreateTextFile("D:\" & fName & ".txt", True)
.Write s: .Close
End With
End With
MsgBox "Ok"
End Sub
Sub IntoTxt()
Dim x, y(), fName$, i&, j&, s$
x = Intersect(ActiveSheet.UsedRange, Selection).Value
If Not IsArray(x) Then Exit Sub
fName = InputBox(Prompt:="Укажите имя файла", Title:="Выберите имя")
If fName = vbNullString Then Exit Sub
ReDim y(1 To UBound(x))
For i = 1 To UBound(x)
For j = 1 To UBound(x, 2)
y(i) = y(i) & x(i, j)
Next j
Next i: s = Join(y, vbCrLf)
'MsgBox "s created" & Len(s)
With CreateObject("scripting.filesystemobject")
With .CreateTextFile("D:\" & fName & ".txt", True)
.Write s: .Close
End With
End With
MsgBox "Ok"
End Sub
Я посмотрел на топик и со стыдом вспомнил, что меня ребята на работе ещё месяца два назад просили сделать им нечто подобное, а я закрутился и забыл.
А теперь вспомнил и дополировал код Николая:
[vba]
Sub ExportSelectionIntoTxt()
Dim X, Y, i&, j&, FileName
X = Intersect(ActiveSheet.UsedRange, ActiveWindow.RangeSelection).Value
If Not IsArray(X) Then MsgBox "Выбрана всего одна ячейка", 48, "Экспорт не выполнен!": Exit Sub
ReDim Y(1 To UBound(X))
For i = 1 To UBound(X)
For j = 1 To UBound(X, 2)
Y(i) = Y(i) & IIf(j = 1, "", vbTab) & X(i, j)
Next j
Next i
Y = Join(Y, vbCrLf)
X = Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".")) & "txt"
FileName = Application.GetSaveAsFilename(InitialFileName:=X, FileFilter:="Text Files (*.txt), *.txt")
If VarType(FileName) = vbBoolean Then Exit Sub ' если нажали "Отмена", то FileName = False
FileName = Left(FileName, InStrRev(FileName, ".")) & "txt"
With CreateObject("Scripting.FileSystemObject")
With .CreateTextFile(FileName, True): .Write Y: .Close: End With
End With
MsgBox "Выбранный диапазон экспортирован в файл" & vbCrLf & FileName, 64, "Экспорт выполнен успешно!"
End Sub
Я посмотрел на топик и со стыдом вспомнил, что меня ребята на работе ещё месяца два назад просили сделать им нечто подобное, а я закрутился и забыл.
А теперь вспомнил и дополировал код Николая:
[vba]
Sub ExportSelectionIntoTxt()
Dim X, Y, i&, j&, FileName
X = Intersect(ActiveSheet.UsedRange, ActiveWindow.RangeSelection).Value
If Not IsArray(X) Then MsgBox "Выбрана всего одна ячейка", 48, "Экспорт не выполнен!": Exit Sub
ReDim Y(1 To UBound(X))
For i = 1 To UBound(X)
For j = 1 To UBound(X, 2)
Y(i) = Y(i) & IIf(j = 1, "", vbTab) & X(i, j)
Next j
Next i
Y = Join(Y, vbCrLf)
X = Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".")) & "txt"
FileName = Application.GetSaveAsFilename(InitialFileName:=X, FileFilter:="Text Files (*.txt), *.txt")
If VarType(FileName) = vbBoolean Then Exit Sub ' если нажали "Отмена", то FileName = False
FileName = Left(FileName, InStrRev(FileName, ".")) & "txt"
With CreateObject("Scripting.FileSystemObject")
With .CreateTextFile(FileName, True): .Write Y: .Close: End With
End With
MsgBox "Выбранный диапазон экспортирован в файл" & vbCrLf & FileName, 64, "Экспорт выполнен успешно!"
End Sub
С уважением,
Алексей
MS Excel 2003 - the best.
Sub ExportSelectionIntoTxt()
Dim X, Y, i&, j&, FileName
X = Intersect(ActiveSheet.UsedRange, ActiveWindow.RangeSelection).Value
If Not IsArray(X) Then MsgBox "Выбрана всего одна ячейка", 48, "Экспорт не выполнен!": Exit Sub
ReDim Y(1 To UBound(X))
For i = 1 To UBound(X)
For j = 1 To UBound(X, 2)
Y(i) = Y(i) & IIf(j = 1, "", vbTab) & X(i, j)
Next j
Next i
Y = Join(Y, vbCrLf)
X = Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".")) & "txt"
FileName = Application.GetSaveAsFilename(InitialFileName:=X, FileFilter:="Text Files (*.txt), *.txt")
If VarType(FileName) = vbBoolean Then Exit Sub ' если нажали "Отмена", то FileName = False
FileName = Left(FileName, InStrRev(FileName, ".")) & "txt"
With CreateObject("Scripting.FileSystemObject")
With .CreateTextFile(FileName, True): .Write Y: .Close: End With
End With
MsgBox "Выбранный диапазон экспортирован в файл" & vbCrLf & FileName, 64, "Экспорт выполнен успешно!"
End Sub
"этот макрос" изменить не получится - нужно писать другой макрос.
Даже вероятно совершенно другой. Hugo
Спасибо за оперативный отклик.
Может подскажете ссылку на готовое решение этой задачки в сети? Интересующийся
Задачка стоИт немного другая - выделение отдельно стоящих ячеек (с помощью CTRL) с последующим сохранением в .txt.
Тот макрос экспортирует только из одного непрерывного диапазона, а не из разрозненных областей, выбранных с зажатым Ctrl
Там явно должен быть цикл перебора Selection.Areas с вложенными циклами по непрерывным диапазонам ячейкек каждой .Area
Задачка стоИт немного другая - выделение отдельно стоящих ячеек (с помощью CTRL) с последующим сохранением в .txt.
Тот макрос экспортирует только из одного непрерывного диапазона, а не из разрозненных областей, выбранных с зажатым Ctrl
Там явно должен быть цикл перебора Selection.Areas с вложенными циклами по непрерывным диапазонам ячейкек каждой .Area Alex_ST
Задачка стоИт немного другая - выделение отдельно стоящих ячеек (с помощью CTRL) с последующим сохранением в .txt.
Тот макрос экспортирует только из одного непрерывного диапазона, а не из разрозненных областей, выбранных с зажатым Ctrl
Там явно должен быть цикл перебора Selection.Areas с вложенными циклами по непрерывным диапазонам ячейкек каждой .Area Автор - Alex_ST
Дата добавления - 20.02.2014 в 20:57
Я ещё раз подчёркиваю что не знаком с VBA, у меня другая специализация, поэтому и обратился на это ресурс. Я не знаком со списком операторов этого языка и не знаю, какие должны из них применяться в случае перебора по всем ячейкам. Обратил внимание только на "верблюжий" синтаксис.
Маленькое "но": странно, но факт - импортировав 2 модуля с вышеуказанной мною ссылки в документ и выбрав различные ячейки в таблице с помощью Ctrl, они, ячейки, сохраняются в текстовом файле именно те, которые были выбраны. Можете сами проверить, это быстро.
Я ещё раз подчёркиваю что не знаком с VBA, у меня другая специализация, поэтому и обратился на это ресурс. Я не знаком со списком операторов этого языка и не знаю, какие должны из них применяться в случае перебора по всем ячейкам. Обратил внимание только на "верблюжий" синтаксис.
Маленькое "но": странно, но факт - импортировав 2 модуля с вышеуказанной мною ссылки в документ и выбрав различные ячейки в таблице с помощью Ctrl, они, ячейки, сохраняются в текстовом файле именно те, которые были выбраны. Можете сами проверить, это быстро. Интересующийся
Интересующийся, Вы меня обманываете.
Модернизировать свой макрос под перебор по очереди ячеек каждой из выделенных областей у меня нет сейчас ни времени, ни большого желания (уж, извините).
Но проверить макрос, ссылку на который Вы дали, я всё-таки удосужился (гордость заела ).
Не экспортируются области, выделенные через Ctrl!
Можете проверить на моём примере.
Выделите ячейки А1, В2, С3 (диагональ) и экспортируйте - получите совсем не то, что ожидали.
Интересующийся, Вы меня обманываете.
Модернизировать свой макрос под перебор по очереди ячеек каждой из выделенных областей у меня нет сейчас ни времени, ни большого желания (уж, извините).
Но проверить макрос, ссылку на который Вы дали, я всё-таки удосужился (гордость заела ).
Не экспортируются области, выделенные через Ctrl!
Можете проверить на моём примере.
Выделите ячейки А1, В2, С3 (диагональ) и экспортируйте - получите совсем не то, что ожидали. Alex_ST
Неожиданно образовалось немного свободного времени на работе.
Допилил процедуру под обработку раздробленного диапазона (набранного с зажатым Ctrl):[vba]
Sub Export_Selection_Into_Txt() ' экспорт выбранных диапазонов в текстовой файл
Dim rArea As Range, i&, j&, X, Y, Z$, FileName
For Each rArea In Intersect(ActiveSheet.UsedRange, ActiveWindow.RangeSelection).Areas
X = rArea.Value ' диапазон —> в массив
If Not IsArray(X) Then ' если это не массив, то значит одна ячейка
Y = X
Else
ReDim Y(1 To UBound(X))
For i = 1 To UBound(X)
For j = 1 To UBound(X, 2) ' собираем значения по ячейкам строк с разделителями vbTab
Y(i) = Y(i) & IIf(j = 1, "", vbTab) & X(i, j)
Next j
Next i
Y = Join(Y, vbCrLf) ' собираем строки с разделителем vbCrLf
End If
Z = Z & Y & vbCrLf & "-----------" & vbCrLf ' собираем области с разделителем vbCrLf & "-----------" & vbCrLf
Next rArea
'Debug.Print Z
X = Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".")) & "txt"
FileName = Application.GetSaveAsFilename(InitialFileName:=X, FileFilter:="Text Files (*.txt), *.txt")
If VarType(FileName) = vbBoolean Then Exit Sub ' если нажали "Отмена", то FileName = False
FileName = Left(FileName, InStrRev(FileName, ".")) & "txt"
With CreateObject("Scripting.FileSystemObject")
With .CreateTextFile(FileName, True): .Write Y: .Close: End With
End With
MsgBox "Выбранный диапазон экспортирован в файл" & vbCrLf & FileName, 64, "Экспорт выполнен успешно!"
End Sub
Неожиданно образовалось немного свободного времени на работе.
Допилил процедуру под обработку раздробленного диапазона (набранного с зажатым Ctrl):[vba]
Sub Export_Selection_Into_Txt() ' экспорт выбранных диапазонов в текстовой файл
Dim rArea As Range, i&, j&, X, Y, Z$, FileName
For Each rArea In Intersect(ActiveSheet.UsedRange, ActiveWindow.RangeSelection).Areas
X = rArea.Value ' диапазон —> в массив
If Not IsArray(X) Then ' если это не массив, то значит одна ячейка
Y = X
Else
ReDim Y(1 To UBound(X))
For i = 1 To UBound(X)
For j = 1 To UBound(X, 2) ' собираем значения по ячейкам строк с разделителями vbTab
Y(i) = Y(i) & IIf(j = 1, "", vbTab) & X(i, j)
Next j
Next i
Y = Join(Y, vbCrLf) ' собираем строки с разделителем vbCrLf
End If
Z = Z & Y & vbCrLf & "-----------" & vbCrLf ' собираем области с разделителем vbCrLf & "-----------" & vbCrLf
Next rArea
'Debug.Print Z
X = Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".")) & "txt"
FileName = Application.GetSaveAsFilename(InitialFileName:=X, FileFilter:="Text Files (*.txt), *.txt")
If VarType(FileName) = vbBoolean Then Exit Sub ' если нажали "Отмена", то FileName = False
FileName = Left(FileName, InStrRev(FileName, ".")) & "txt"
With CreateObject("Scripting.FileSystemObject")
With .CreateTextFile(FileName, True): .Write Y: .Close: End With
End With
MsgBox "Выбранный диапазон экспортирован в файл" & vbCrLf & FileName, 64, "Экспорт выполнен успешно!"
End Sub
С уважением,
Алексей
MS Excel 2003 - the best.
Sub Export_Selection_Into_Txt() ' экспорт выбранных диапазонов в текстовой файл
Dim rArea As Range, i&, j&, X, Y, Z$, FileName
For Each rArea In Intersect(ActiveSheet.UsedRange, ActiveWindow.RangeSelection).Areas
X = rArea.Value ' диапазон —> в массив
If Not IsArray(X) Then ' если это не массив, то значит одна ячейка
Y = X
Else
ReDim Y(1 To UBound(X))
For i = 1 To UBound(X)
For j = 1 To UBound(X, 2) ' собираем значения по ячейкам строк с разделителями vbTab
Y(i) = Y(i) & IIf(j = 1, "", vbTab) & X(i, j)
Next j
Next i
Y = Join(Y, vbCrLf) ' собираем строки с разделителем vbCrLf
End If
Z = Z & Y & vbCrLf & "-----------" & vbCrLf ' собираем области с разделителем vbCrLf & "-----------" & vbCrLf
Next rArea
'Debug.Print Z
X = Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".")) & "txt"
FileName = Application.GetSaveAsFilename(InitialFileName:=X, FileFilter:="Text Files (*.txt), *.txt")
If VarType(FileName) = vbBoolean Then Exit Sub ' если нажали "Отмена", то FileName = False
FileName = Left(FileName, InStrRev(FileName, ".")) & "txt"
With CreateObject("Scripting.FileSystemObject")
With .CreateTextFile(FileName, True): .Write Y: .Close: End With
End With
MsgBox "Выбранный диапазон экспортирован в файл" & vbCrLf & FileName, 64, "Экспорт выполнен успешно!"
End Sub
- Номер_файла – обязательный параметр, представляющий из себя номер, присвоенный файлу при открытии с помощью оператора Open.
- Переменные – обязательный параметр, представляющий из себя список переменных, разделенных запятой, которым присваиваются значения, считанные из файла.
- Номер_файла – обязательный параметр, представляющий из себя номер, присвоенный файлу при открытии с помощью оператора Open.
- Переменная – обязательный параметр, представляющий из себя имя переменной, объявленной как String или Variant, которой присваивается строка, считанная из файла.
- Номер_файла – обязательный параметр, представляющий из себя номер, присвоенный файлу при открытии с помощью оператора Open.
- Данные – необязательный параметр, представляющий из себя одно или несколько числовых или строковых выражений, разделенных запятой, которые нужно записать в файл.
Функция EOF
Функция EOF возвращает логическое значение True, когда достигнут конец файла, открытого для последовательного (Input) или произвольного (Random) доступа.
Синтаксис функции EOF:
Номер_файла – это номер, присвоенный файлу при открытии с помощью оператора Open.
Функция EOF используется для предупреждения ошибок, вызываемых попытками выполнить чтение после конца файла. Она возвращает значение False, пока не будет достигнут конец файла.
Примеры чтения и записи в файл
Пример 1
Открытие (или создание, если он не существует) текстового файла для чтения и записи и запись в него одной строки, состоящей из двух текстовых и одного числового значений. Файл с именем myFile1.txt будет создан в той же папке, где расположен файл Excel с кодом VBA.
Пример 2
Открытие (или создание, если он не существует) файла без расширения для чтения и записи и запись в него трех строк: двух текстовых и одной в числовом формате. Файл с именем myFile2 будет создан в той же папке, где расположен файл Excel с кодом VBA.
Так как у файла нет расширения, Windows выведет диалоговое окно для выбора открывающей его программы. Выберите любой текстовый редактор или интернет-браузер.
Пример 3
Считываем строку, разделенную на отдельные элементы, из файла myFile1.txt и записываем в три переменные, по типу данных соответствующие элементам.
Пример 4
Считываем поочередно три строки из файла myFile2 и записываем в три элемента массива, объявленного как Variant, так как в этот файл ранее были записаны две строки с текстом и одна с числом.
Сохранение одномерного массива в текстовый файл с добавлением разделителя между его элементами.
Объявляем переменную универсального типа, создаем из нее массив, заполнив ее данными с помощью функции Array:
Теперь создаем текстовый файл с помощью метода CreateTextFile. Создаем, а не открываем, для того, чтобы, если такой файл с данными уже существует, от был перезаписан новым пустым файлом.
Если переменную, предназначенную для создания нового объекта TextStream объявить явно: fl As TextStream , то станут доступны подсказки для автозаполнения свойств и методов этого объекта при написании кода.
Сохраняем информацию из массива в текстовый файл с помощью цикла For… Next:
В качестве разделителя элементов массива используется символ «;». Если точка с запятой встречается в содержимом элементов массива, следует использовать другой разделитель.
Закрываем объект TextStream и открываем созданный текстовый файл для просмотра:
Полный код процедуры VBA Excel для сохранения одномерного массива в текстовый файл:
Сохранение двумерного массива
Сохранение двумерного массива в текстовый файл с использованием в качестве разделителей точки с запятой (для элементов в одной строке) и переноса строки.
Раз у нас VBA Excel, то и заполнять двумерный массив будем данными с рабочего листа:
В результате будет создан массив с размерностью (1 to 8, 1 to 4) . Первое измерение массива соответствует строкам диапазона, в второе – столбцам.
Создаем текстовый файл (или перезаписываем существующий) и открываем связанный с ним объект TextStream для записи данных из массива:
Записываем данные из двумерного массива в текстовый файл:
Закрываем объект TextStream и открываем созданный текстовый файл для просмотра:
Полный код процедуры VBA Excel для сохранения двумерного массива в текстовый файл:
Заполнение массива из текстового файла
Заполнение одномерного массива
Обратное заполнение с помощью кода VBA Excel одномерного массива данными из созданного текстового файла "C:\test\testfile1.txt" :
Заполнение двумерного массива
Обратное заполнение с помощью кода VBA Excel двумерного массива из созданного текстового файла "C:\test\testfile2.txt" .
Копируем информацию из текстового файла в переменную myString1:
Что мы теперь имеем? Все данные из файла "C:\test\testfile2.txt" скопированы в переменную myString1 с исходной структурой: со знаком переноса строки в качестве разделителя строк и точкой с запятой в качестве разделителя столбцов. Этой информацией мы и воспользуемся для заполнения массива myArray() .
Данные функции предназначены для работы с текстовыми файлами из VBA Excel.
Используя эти функции, вы при помощи одной строки кода сможете записать текст из переменной в файл, или наоборот, загрузить содержимое текстового файла в переменную.
Чтение текстового файла в переменную:
Комментарии
Могу написать макрос под заказ (платно)
Как можно задать строки для чтения/записи из txt?
Пример:
Есть файл txt
Прораб
Вася
Петя
Работники
Саша
Андрей
Коля
Необходимо занести имена прорабов в один массив arr1(), а имена работников в другой arr2(). Изменить имена рабочих и их количество и вернуть в txt новые значения. Т.е. массивы динамические, а идентифицируем начало и конец соответствующего массива в txt по шапке в начале и пустой строке в конце.
В UTF-8 сохранять так
Function SaveTXTfile(ByVal filename As String, ByVal txt As String) As Boolean
On Error Resume Next: Err.Clear
Set stream = CreateObject("ADODB.Stream")
stream.Type = 2 'text
stream.Charset = "utf-8"
stream.Open
stream.writetext Replace(txt, Chr(10), vbNewLine)
stream.savetofile filename, 2
End Function
Добрый день!
Помогите еще в одной вещи.
По дефолту пишет в ANSI, а нужно UTF-8
Neri, замените в коде
Добрый день!
У меня есть ячейка, в которой спомощью функции сцепить собраные несколько значений и исползуется символ переноса строки
Выглядит это примерно вот так:
=СЦЕПИТЬ(R3 & СИМВОЛ(10) & S3 & СИМВОЛ(10))
"Строка 1"
"Строка 2"
Как можно записать в файл, но чтобы каждая строка писалась с новой строки?
Добрый день. А кто подскажет, какие применять команды для поиска части текста в файле (.xml), потом копировать его и этим текстом переименовывать папку или файл этот же? Спасибо.
получится что-то типа такого:
помогите плиииз решить задачку . у меня есть файл Эксель, мне его надо сохранить как текстовый с кодировкой Unicode, но при сохранении в этом формате програма добавляет две пустые строки, мне удалось убрать две пустые строки, но теперь он в конце первой строки ставит какой то символ, который я никак не могу убрать. где ошибка
Никто не спорит, - улучшать (дорабатывать) функцию можно бесконечно.
Чтобы нужные строки из файла брались, - кода будет в несколько раз больше.
Можете сами написать подобную функцию, взяв за основу этот код,
и сделав выборку нужный строки из массива.
Ну или заказать готовое решение.
А вопрос то актуальный. Дополнив функцию этой возможностью, её функционал стал бы гораздо качественне.
Можно с помощью Вашей функции взять только определенные строки, например со 2 по 20
Уберите строку Option Explicit - тогда не будет выскакивать ошибка Variable not defined
Пишет Variable not defined, указывая на binaryStream. Странно, ведь там все так же. :(
Mix, используйте эту функцию с третьим параметром "utf-8noBOM"
Добрый вечер!
Делаю по второму примеру, файл сохраняется в кодировке ANSI. Подскажите, как изменить данный пример чтобы сохранялось в кодировке utf-8 без BOM?
Это мое первое общение с VBA :)
Можно, конечно, и номер строки задать, откуда будут вставляться данные, - но код будет намного сложнее.
Алгоритм:
1) считываем весь текст из файла
2) разбиваем его на 2 части (по заданному номеру строки
3) формируем новый текст: 1-я часть + вставляемый текст + 2-я часть
4) записываем результат в тот же файл
Насчёт XML: очень не рекомендую использовать такой метод для XML, очень вероятны ошибки.
Там проще использовать объектную модель XML, программно добавляя новые узлы.
Очень интересна функция Добавление в текстовый файл из переменной, но так как я только начала изучать VBA, непонятно можно ли указать номер строки (в середине текста) начиная с которой начать добавление строк. И можно ли использовать эту функцию для добавления xml файл?
Здравствуйте! Подскажите пожалуйста, какой код надо написать, чтобы работал такой макрос: по нажатию кнопки выбирать папку, в которой есть текстовые файлы. В книгу вставляются листы с названиями от имени файлов в этой папке и в эти листы вводятся данные из этих файлов. Файлы содержат разную информацию: матрица, фамилии и дата рождения и т.д. Спасибо.
Anddre - если заменить "ReadTXTfile" на "txt",
то тогда функция будет всегда возвращать пустое значение. Любая Ф-я почти всегда должна содержать оператор присвоения значения переменной с именем самой функции.
Наконец я нашел решение! Спасибо огромное!
В моем случае, при сохранении TXTфайла с разделителями табуляции, нужно было записать первым пустой столбец, но любимый EXCEL сносил его и записывал файл таким образом что все столбцы смещались влево на одну позицию. запись Cells(1,1) = chr(09) приводила к возникновению цепочки сиволов кавычки-табуляция-кавычки в начале файла.
Пришлось прописывать Cells(1,1) = "?" (покрайней мере его видно в тексте), и тогда структура вроде сохранялась. Но система под которую этот файлик готовился могла на такое "нововведение" заругаться.
Как же я обрадовался когда удалось удалить из первой позиции аккруратно вырезать этот "?" и перезаписать файл в чистом виде.
Еще раз спасибо.
Спасибо за ресурс! Очень полезный. У меня несколько вопросов:
1) OpenTextFile(filename, 1, True)
второй и третий параметр этой функции что означают?
(а то редактор не выводит всплывающую подсказку)
2) Можно ли как-то считать только вторую строку текстового файла или записать во вторую строку?
3) При выведении значения в ячейку с помощью ReadTXTfile, в конце строки вместо переноса у меня стоит квадратик (нераспознанный знак), этого как-то можно избежать?
Заменить-то можно, но зачем?
Тогда придётся писать в коде дополнительную строку ReadTXTfile = txt
чтобы функция возвратила считанный из файла текст.
А так, как сейчас, всё работает без лишних строк.
(Мы намеренно записываем текст именно в ReadTXTfile, а не в какую-то текстовую переменную, поскольку функция должна возвратить загруженный текст)
1000 извинений, но не лучше ли в строке функции "Чтение текстового файла в переменную":
Set ts = fso.OpenTextFile(filename, 1, True): ReadTXTfile = ts.ReadAll: ts.Close
заменить "ReadTXTfile" на "txt",
чтобы имя переменной - txt
отличалось от имени функции ReadTXTfile
Необходимо написать код, который будет бегать по листу Excel'я, данные записывать в текстовый файл, и сохранять текстовый файл в туже директорию, где лежит файл с макросом.
Написал вот такой код:
[vba]
Set objFSO = CreateObject("Scripting.FileSystemObject")
v = ThisWorkbook.Path
Set objFile = objFSO.CreateTextFile(v & ActiveSheet.Name & ".txt")
For i = 2 To Sheets("sec").UsedRange.Rows.Count
For j = 4 To Sheets("sec").UsedRange.Columns.Count
If Sheets("sec").Cells(i, j).Value <> "" Then
objFile.writeline (Sheets("sec").Cells(i, j).Value)
End If
Next j
Next i
MsgBox ("Созданный файл сохранен: " & ThisWorkbook.Path)
Однако, файл не сохраняется. Причем я вижу, что директория в ThisWorkbook.Path отображается верно. Вариант с ActiveWorkbook.Path тоже пробовал, не помогло.
Подскажите пожалуйста, в чем может быть проблема!
Необходимо написать код, который будет бегать по листу Excel'я, данные записывать в текстовый файл, и сохранять текстовый файл в туже директорию, где лежит файл с макросом.
Написал вот такой код:
[vba]
Set objFSO = CreateObject("Scripting.FileSystemObject")
v = ThisWorkbook.Path
Set objFile = objFSO.CreateTextFile(v & ActiveSheet.Name & ".txt")
For i = 2 To Sheets("sec").UsedRange.Rows.Count
For j = 4 To Sheets("sec").UsedRange.Columns.Count
If Sheets("sec").Cells(i, j).Value <> "" Then
objFile.writeline (Sheets("sec").Cells(i, j).Value)
End If
Next j
Next i
MsgBox ("Созданный файл сохранен: " & ThisWorkbook.Path)
Однако, файл не сохраняется. Причем я вижу, что директория в ThisWorkbook.Path отображается верно. Вариант с ActiveWorkbook.Path тоже пробовал, не помогло.
Подскажите пожалуйста, в чем может быть проблема! Red_Sloth
Необходимо написать код, который будет бегать по листу Excel'я, данные записывать в текстовый файл, и сохранять текстовый файл в туже директорию, где лежит файл с макросом.
Написал вот такой код:
[vba]
Set objFSO = CreateObject("Scripting.FileSystemObject")
v = ThisWorkbook.Path
Set objFile = objFSO.CreateTextFile(v & ActiveSheet.Name & ".txt")
For i = 2 To Sheets("sec").UsedRange.Rows.Count
For j = 4 To Sheets("sec").UsedRange.Columns.Count
If Sheets("sec").Cells(i, j).Value <> "" Then
objFile.writeline (Sheets("sec").Cells(i, j).Value)
End If
Next j
Next i
MsgBox ("Созданный файл сохранен: " & ThisWorkbook.Path)
Однако, файл не сохраняется. Причем я вижу, что директория в ThisWorkbook.Path отображается верно. Вариант с ActiveWorkbook.Path тоже пробовал, не помогло.
Подскажите пожалуйста, в чем может быть проблема! Автор - Red_Sloth
Дата добавления - 10.02.2016 в 18:14
Читайте также: