![]() Главная страница Случайная страница КАТЕГОРИИ: АвтомобилиАстрономияБиологияГеографияДом и садДругие языкиДругоеИнформатикаИсторияКультураЛитератураЛогикаМатематикаМедицинаМеталлургияМеханикаОбразованиеОхрана трудаПедагогикаПолитикаПравоПсихологияРелигияРиторикаСоциологияСпортСтроительствоТехнологияТуризмФизикаФилософияФинансыХимияЧерчениеЭкологияЭкономикаЭлектроника |
Импорт данных, для которых нужно более 256 столбцов
Листинг 2.10. Импорт большого количества данных Sub ImportWideSheet() Dim rgRange As Range ' Хранит заполняемую ячейку Dim lngRow As Long ' Хранит номер текущей строки Dim intCol As Integer ' Хранит номер текущего столбца Dim i As Integer Dim strLine As String ' Обрабатываемая строка (из файла) Dim strCurChar As String * 1 Dim strCellValue As String ' В этой строке формируется значение _ заполняемой ячейки таблицы Dim wshtCurrentSheet As Worksheet ' Лист, на котором находится _ заполняемая ячейка
' Отключение обновления изображения Application.ScreenUpdating = False
' Создание книги с одним листом Workbooks.Add xlWorksheet Set rgRange = ActiveWorkbook.Sheets(1).Range(" A1")
' Чтение первой строки из файла (по этой строке определяется _ ширина таблицы) Open ThisWorkbook.Path & " \Primer.txt" For Input As #1 Line Input #1, strLine ' Обработка первой строки с добавлением новых листов по мере _ необходимости For i = 1 To Len(strLine) strCurChar = Mid(strLine, i, 1) ' Проверка - закончились столбцы или нет If intCol < > 0 And intCol Mod 256 = 0 Then ' Столбцы текущего листа закончились - добавим новый лист _ и перейдем к его первому столбцу Set wshtCurrentSheet = ActiveWorkbook.Sheets.Add(, _ ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)) Set rgRange = wshtCurrentSheet.Range(" A1") intCol = 0 End If
' Проверка - закончилось поле или нет If strCurChar = ", " Then ' Запишем данные в таблицу rgRange.Offset(lngRow, intCol) = strCellValue intCol = intCol + 1 strCellValue = " " Else ' Добавляем очередной символ в строку со значением текущей _ ячейки strCellValue = strCellValue & Mid(strLine, i, 1)
' Проверка - конец строки или нет If i = Len(strLine) Then ' Дошли до конца строки - запишем значение последней ячейки rgRange.Offset(lngRow, intCol) = strCellValue intCol = 0 strCellValue = " " End If End If Next i
' Чтение остальных строк файла Do Until EOF(1) Set rgRange = ActiveWorkbook.Sheets(1).Range(" A1") lngRow = lngRow + 1 intCol = 0 Line Input #1, strLine
' Обработка считанной строки For i = 1 To Len(strLine) strCurChar = Mid(strLine, i, 1) ' Проверка - закончились столбцы или нет If intCol < > 0 And intCol Mod 256 = 0 Then ' Столбцы текущего листа закончились - добавим новый лист _ и перейдем к его первому столбцу Set wshtCurrentSheet = ActiveWorkbook.Sheets.Add(, _ ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)) Set rgRange = wshtCurrentSheet.Range(" A1") intCol = 0 End If
' Проверка - закончилось поле или нет If strCurChar = ", " Then ' Запишем данные в таблицу rgRange.Offset(lngRow, intCol) = strCellValue intCol = intCol + 1 strCellValue = " " Else ' Добавляем очередной символ в строку со значением текущей _ ячейки strCellValue = strCellValue & Mid(strLine, i, 1)
' Проверка - конец строки или нет If i = Len(strLine) Then ' Дошли до конца строки - запишем значение последней _ ячейки rgRange.Offset(lngRow, intCol) = strCellValue strCellValue = " " End If End If Next i Loop
' Не забываем закрыть входной файл Close #1 ' и разрешить обновление изображения Application.ScreenUpdating = True End Sub
|