Сохранение одномерного и двумерного массивов в текстовый файл с помощью кода VBA Excel и обратное заполнение массивов данными из текстового файла.
Сохранение массива в текстовый файл
Сохранение одномерного массива
Сохранение одномерного массива в текстовый файл с добавлением разделителя между его элементами.
Объявляем переменную универсального типа, создаем из нее массив, заполнив ее данными с помощью функции Array:
|
1 2 |
Dim myArray myArray = Array("карась", "ветка", 0.5698, "бегемот", "рысь", "2354") |
Теперь создаем текстовый файл с помощью метода CreateTextFile. Создаем, а не открываем, для того, чтобы, если такой файл с данными уже существует, от был перезаписан новым пустым файлом.
|
1 2 3 4 5 6 |
Dim fso, fl As TextStream 'Создаем новый экземпляр объекта FileSystemObject Set fso = CreateObject("Scripting.FileSystemObject") 'Присваиваем переменной fl новый объект TextStream, 'связанный с созданным и открытым для записи файлом Set fl = fso.CreateTextFile("C:\test\testfile1.txt") |
Если переменную, предназначенную для создания нового объекта TextStream объявить явно: fl As TextStream, то станут доступны подсказки для автозаполнения свойств и методов этого объекта при написании кода.
Сохраняем информацию из массива в текстовый файл с помощью цикла For… Next:
|
1 2 3 4 5 6 7 8 |
Dim i For i = 0 To UBound(myArray) If i = UBound(myArray) Then fl.Write (myArray(i)) Else fl.Write (myArray(i) & ";") End If Next |
В качестве разделителя элементов массива используется символ «;». Если точка с запятой встречается в содержимом элементов массива, следует использовать другой разделитель.
Закрываем объект TextStream и открываем созданный текстовый файл для просмотра:
|
1 2 3 4 5 6 |
'Закрываем TextStream fl.Close 'Открываем файл для просмотра Dim ws Set ws = CreateObject("WScript.Shell") ws.Run "C:\test\testfile1.txt" |
Полный код процедуры VBA Excel для сохранения одномерного массива в текстовый файл:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 |
Sub Primer1() Dim myArray, fso, fl As TextStream, i, ws myArray = Array("карась", "ветка", 0.5698, "бегемот", "рысь", "2354") Set fso = CreateObject("Scripting.FileSystemObject") Set fl = fso.CreateTextFile("C:\test\testfile1.txt") For i = 0 To UBound(myArray) If i = UBound(myArray) Then fl.Write (myArray(i)) Else fl.Write (myArray(i) & ";") End If Next fl.Close Set ws = CreateObject("WScript.Shell") ws.Run "C:\test\testfile1.txt" End Sub |
Рекомендую открывать файлы для просмотра методом ThisWorkbook.FollowHyperlink. Пример и преимущества этого метода в статье VBA Excel. Открыть файл другой программы.
Сохранение двумерного массива
Сохранение двумерного массива в текстовый файл с использованием в качестве разделителей точки с запятой (для элементов в одной строке) и переноса строки.
Раз у нас VBA Excel, то и заполнять двумерный массив будем данными с рабочего листа:
|
1 2 |
Dim myArray myArray = Range("A1:D8") |
В результате будет создан массив с размерностью (1 to 8, 1 to 4). Первое измерение массива соответствует строкам диапазона, в второе – столбцам.
Создаем текстовый файл (или перезаписываем существующий) и открываем связанный с ним объект TextStream для записи данных из массива:
|
1 2 3 4 5 6 |
Dim fso, fl As TextStream 'Создаем новый экземпляр объекта FileSystemObject Set fso = CreateObject("Scripting.FileSystemObject") 'Присваиваем переменной fl новый объект TextStream, 'связанный с созданным и открытым для записи файлом Set fl = fso.CreateTextFile("C:\test\testfile2.txt") |
Записываем данные из двумерного массива в текстовый файл:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 |
Dim i1, i2 For i1 = 1 To UBound(myArray, 1) For i2 = 1 To UBound(myArray, 2) 'Если столбец не последний, добавляем к значению элемента разделитель If i2 <> UBound(myArray, 2) Then fl.Write (myArray(i1, i2) & ";") 'ИначеЕсли столбец последний, а строка не последняя, добавляем к значению знак переноса строки 'знак переноса строки к записываемому тексту добавляет метод WriteLine объекта TextStream ElseIf i2 = UBound(myArray, 2) And i1 <> UBound(myArray, 1) Then fl.WriteLine (myArray(i1, i2)) 'Иначе (если столбец последний и строка последняя, к значению ничего не добавляем) Else fl.Write (myArray(i1, i2)) End If Next Next |
Закрываем объект TextStream и открываем созданный текстовый файл для просмотра:
|
1 2 3 4 5 6 |
'Закрываем TextStream fl.Close 'Открываем файл для просмотра Dim ws Set ws = CreateObject("WScript.Shell") ws.Run "C:\test\testfile2.txt" |
Полный код процедуры VBA Excel для сохранения двумерного массива в текстовый файл:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 |
Sub Primer2() Dim myArray, fso, fl As TextStream, i1, i2, ws myArray = Лист5.Range("A1:D8") Set fso = CreateObject("Scripting.FileSystemObject") Set fl = fso.CreateTextFile("C:\test\testfile2.txt") For i1 = 1 To UBound(myArray, 1) For i2 = 1 To UBound(myArray, 2) If i2 <> UBound(myArray, 2) Then fl.Write (myArray(i1, i2) & ";") ElseIf i2 = UBound(myArray, 2) And i1 <> UBound(myArray, 1) Then fl.WriteLine (myArray(i1, i2)) Else fl.Write (myArray(i1, i2)) End If Next Next fl.Close Set ws = CreateObject("WScript.Shell") ws.Run "C:\test\testfile2.txt" End Sub |
Рекомендую открывать файлы для просмотра методом ThisWorkbook.FollowHyperlink. Пример и преимущества этого метода в статье VBA Excel. Открыть файл другой программы.
Заполнение массива из текстового файла
Заполнение одномерного массива
Обратное заполнение с помощью кода VBA Excel одномерного массива данными из созданного текстового файла "C:\test\testfile1.txt":
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 |
Sub Primer3() Dim fso, fl, myString1, myArray 'Создаем новый экземпляр объекта FileSystemObject Set fso = CreateObject("Scripting.FileSystemObject") 'Присваиваем переменной fl новый объект TextStream, 'связанный с открытым для чтения файлом Set fl = fso.OpenTextFile("C:\test\testfile1.txt") 'Считываем весь текст из файла в переменную myString1 myString1 = fl.ReadAll 'Закрываем объект TextStream fl.Close 'Создаем массив из переменной myArray, 'записав в него элементы с помощью функции Split myArray = Split(myString1, ";") 'Извлекаем данные из массива для проверки работоспособности кода 'и отображаем их в информационном окне MsgBox Dim myString2 For Each myString1 In myArray myString2 = myString2 & myString1 & vbNewLine Next MsgBox myString2 End Sub |
Заполнение двумерного массива
Обратное заполнение с помощью кода VBA Excel двумерного массива из созданного текстового файла "C:\test\testfile2.txt".
Копируем информацию из текстового файла в переменную myString1:
|
1 2 3 4 5 6 7 8 9 10 |
Dim fso, fl As TextStream, myString1 'Создаем новый экземпляр объекта FileSystemObject Set fso = CreateObject("Scripting.FileSystemObject") 'Присваиваем переменной fl новый объект TextStream, 'связанный с открытым для чтения файлом Set fl = fso.OpenTextFile("C:\test\testfile2.txt") 'Считываем весь текст из файла в переменную myString1 myString1 = fl.ReadAll 'Закрываем объект TextStream fl.Close |
Что мы теперь имеем? Все данные из файла "C:\test\testfile2.txt" скопированы в переменную myString1 с исходной структурой: со знаком переноса строки в качестве разделителя строк и точкой с запятой в качестве разделителя столбцов. Этой информацией мы и воспользуемся для заполнения массива myArray().
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 |
Dim myArrayTemp1, myArrayTemp2, myArray(), s, c, i1, i2 'Временный массив myArrayTemp1 заполняем целыми 'строками в качестве отдельных элементов myArrayTemp1 = Split(myString1, vbNewLine) 'Определяем количество строк s = UBound(myArrayTemp1) + 1 'Определяем количество столбцов, разделив на элементы 'нулевой элемент массива myArrayTemp1 c = UBound(Split(myArrayTemp1(0), ";")) + 1 'Переопределяем размерность массива ReDim myArray(1 To s, 1 To c) 'Заполняем массив myArray данными с помощью вложенного цикла For... Next For i1 = 1 To s 'Временный массив myArrayTemp2 заполняем элементами, 'полученными в результате разделения по очереди всех 'элементов массива myArrayTemp1 myArrayTemp2 = Split(myArrayTemp1(i1 - 1), ";") 'Заполняем построчно основной массив myArray 'элементами массива myArrayTemp2 For i2 = 1 To c myArray(i1, i2) = myArrayTemp2(i2 - 1) Next Next |
Проверяем заполненный массив копированием данных из него на рабочий лист:
|
1 |
Лист5.Range("A11:D18") = myArray |
Полный код процедуры VBA Excel для обратного заполнения двумерного массива из текстового файла:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 |
Sub Primer4() Dim fso, fl, myString1 Set fso = CreateObject("Scripting.FileSystemObject") Set fl = fso.OpenTextFile("C:\test\testfile2.txt") myString1 = fl.ReadAll fl.Close Dim myArrayTemp1, myArrayTemp2, myArray(), s, c, i1, i2 myArrayTemp1 = Split(myString1, vbNewLine) s = UBound(myArrayTemp1) + 1 c = UBound(Split(myArrayTemp1(0), ";")) + 1 ReDim myArray(1 To s, 1 To c) For i1 = 1 To s myArrayTemp2 = Split(myArrayTemp1(i1 - 1), ";") For i2 = 1 To c myArray(i1, i2) = myArrayTemp2(i2 - 1) Next Next Лист5.Range("A11:D18") = myArray End Sub |
Добрый день, Евгений!
Подскажите пожалуйста, как сохранить массив в файл через вызов FileDialog, чтобы можно было назначить произвольное имя и выбрать нужную директорию?
Диалог открывается, но создать файл и записать туда массив не получается.
Заранее спасибо!
Здравствуйте, Николай!
Метод Application.GetSaveAsFilename создает только имя файла, но не создает и не сохраняет файл, в том числе при нажатии кнопки «Сохранить». Для создания файла и заполнения его данными необходим отдельный код, использующий полное имя, записанное в переменную Path.