Экспорт и импорт данных

Листинг 3.58. Экспорт и импорт данных

Sub ExportAsText()

Dim lngRow As Long

Dim intCol As Integer

' Открытие файла для сохранения

Open " C: \primer.txt" For Output As #1

' Запись выделенной части таблицы в файл (построчно)

For lngRow = 1 To Selection.Rows.Count

' Запись содержимого всех столбцов строки lngRow

For intCol = 1 To Selection.Columns.Count

Write #1, Selection.Cells(lngRow, intCol).Value;

Next intCol

' Начнем новую строку в файле

Print #1, " "

Next lngRow

' Не забываем закрыть файл

Close #1

End Sub

Sub ImportText()

Dim strLine As String ' Одна строка файла

Dim strCurChar As String * 1 ' Анализируемый символ строки файла

Dim strValue As String ' Значение для записи в ячейку

Dim lngRow As Long ' Номер текущей строки

Dim intCol As Integer ' Номер текущего столбца

Dim i As Integer

' Открытие импортируемого файла

Open " C: \primer.txt" For Input As #1

' Считываем все строки файла и записываем данные, разделенные _

запятой, в ячейки таблицы (начиная с текущей ячейки)

Do Until EOF(1)

' Считываем строку из файла

Line Input #1, strLine

' Разбираем считанную строку

For i = 1 To Len(strLine)

strCurChar = Mid(strLine, i, 1)

If strCurChar = ", " Then

' Найден разделитель столбцов - запятая. Запишем _

сформированное значение в ячейку

ActiveCell.Offset(lngRow, intCol) = strValue

intCol = intCol + 1

strValue = " "

ElseIf i = Len(strLine) Then

' Конец строки - запишем в таблицу последнее _

значение в строке (перед этим дополним его последним _

символом строки, кроме кавычки)

If strCurChar < > Chr(34) Then

strValue = strValue & strCurChar

End If

' Запись в таблицу

ActiveCell.Offset(lngRow, intCol) = strValue

strValue = " "

ElseIf strCurChar < > Chr(34) Then

' Добавление символа в формируемое значение ячейки _

(кавычки игнорируются)

strValue = strValue & strCurChar

End If

Next i

' Переход к новой строке таблицы

intCol = 0

lngRow = lngRow + 1

Loop

' Закрываем файл

Close #1

End Sub

Одновременное умножение всех данных диапазона

Листинг 3.59. Умножение данных

Sub MultAllCells()

Dim dblMult As Double

Dim cell As Range

' Ввод коэффициента для умножения

dblMult = InputBox(" Введите коэффициент, на который следует умножать")

' Умножение содержимого на введенный коэффициент

For Each cell In Selection

If IsNumeric(cell.Value) And cell.Value < > " " Then

' Умножаются только ячейки, содержащие числовые данные

cell.Value = cell.Value * dblMult

Else

MsgBox " В ячейке " & cell.Address & " нечисловое значение"

End If

Next

End Sub