![]() Главная страница Случайная страница КАТЕГОРИИ: АвтомобилиАстрономияБиологияГеографияДом и садДругие языкиДругоеИнформатикаИсторияКультураЛитератураЛогикаМатематикаМедицинаМеталлургияМеханикаОбразованиеОхрана трудаПедагогикаПолитикаПравоПсихологияРелигияРиторикаСоциологияСпортСтроительствоТехнологияТуризмФизикаФилософияФинансыХимияЧерчениеЭкологияЭкономикаЭлектроника |
Экспорт и импорт данных
Листинг 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
|