Быстрая обработка данных Excel в Delphi.

Источник: webdelphi

webdelphi

Праздники ещё не закончились, работать лень, но надо как-то уже прекращать заниматься кишкоблудством и начинать работать в полную силу. Ну, а чтобы как-то себя расшевелить и начать уже работу в блоге, решил первый пост сделать простым - снова сказать несколько слов про Excel. Дело в том, что с момента выхода поста под названием "Работа с Excel в Delphi. Основы основ." прошло практически полтора года и этот пост (почему-то вопреки всем ожиданиям) очень прочно закрепился в выдаче поисковиков. Это, конечно хорошо, но этот пост (читай название) дает лишь небольшое представление о том как работать с Excel в Delphi. Никто ведь не изучает сразу квантовую механику с первого класса? Сначала учимся основам вообще - математика, физика и т.д. Так я решил поступить в начале рассказа про Excel - сначала дать общее представление, а потом по-тихоньку раскрывать тему более подробно и детально. Но поисковики немного спутали карты, подняв пост выше других про Excel. Соответственно, те из посетителей, кто уже имеют представление о работе с Excel, видя представленные в статье примеры, возмущаются по поводу того, что чтение данных в этом случае будет происходить медленно. И я не спорю, да проход по каждой ячейке листа - это жуткие тормоза. А ускорить процесс чтения можно и необходимо. Поэтому можно считать, что эта статья - расширение к основам.

За полтора года мне предлагали кучу вариантов того как ускорить чтение данных с листа Excel - от использования MSXML и других готовых библиотек до самопальных процедур и функций. Что ж, любую задачу можно решить несколькими способами. Рассмотрим несколько вариантов и определимся какой из вариантов окажется наиболее быстрым. Ну, а какой вариант окажется более удобным - это уже каждый решит для себя сам.

Чтение данных из Excel

Вначале рассмотрим вариант чтения данных использованием которого грешат те, кто только начинает свое знакомство с Excel в Delphi - чтение данных из каждой ячейки по отдельности. Тестовая процедура с таким вариантом чтения может выглядеть следующим образом:

procedure TForm16.SlowVariant;
var Rows, Cols, i,j: integer;
    WorkSheet: OLEVariant;
    d: TDateTime;
begin
  //открываем книгу
  ExcelApp.Workbooks.Open(edFile.Text);
  //получаем активный лист
  WorkSheet:=ExcelApp.ActiveWorkbook.ActiveSheet;
  //определяем количество строк и столбцов таблицы
  Rows:=WorkSheet.UsedRange.Rows.Count;
  Cols:=WorkSheet.UsedRange.Columns.Count;
 
  StringGrid1.RowCount:=Rows;
  StringGrid1.ColCount:=Cols;
 
  //засекаем время начала чтения
  d:=Now;
 
  //выводим данные в таблицу
  for I := 0 to Rows-1 do
    for j := 0 to Cols-1 do
        StringGrid1.Cells[J,I]:=WorkSheet.UsedRange.Cells[I+1,J+1].Value;
 
 Label2.Caption:='Время чтения всего листа: '+FormatDateTime('hh:mm:ss:zzz',
    Now()-d);
end;

Счётчик будет в итоге содержать время чтения и вывода в StringGrid данных. Можно было бы сделать счётчик исключительно на чтение данных с листа, но я решил не перегружать исходник лишними переменными. Если будет желание - можете переписать чуть-чуть исходник и получить "чистое" время чтения.

Для теста этого варианта был создан лист Excel, содержащий 143 строки и 142 столбца с данными, т.е. 20306 ячеек с данными. На рисунке ниже представлено значение счётчика после чтения данных:

12 секунд на чтение...а если будет 1000 строк и 1000 столбцов? Так можно и не дождаться окончания операции.

Если внимательно посмотреть на процедуру, представленную выше, то можно видеть, что в цикле мы каждый раз при каждой итерации вначале получаем диапазон, занятый данными, затем в этом диапазоне получаем определенную ячейку и только потом считываем значение в ячейке. На самом деле столько лишних операций для чтения данных с листа не требуется. Тем более, когда данные располагаются непрерывным массивом. Более выгодным в этом случае вариантом чтения будет чтение данных сразу из всего диапазона в массив.

На деле реализация этого варианты работы окажется даже проще, чем представленного выше. Смотрите сами. Вот вариант чтения данных целым диапазоном:

procedure TForm16.RangeRead;
var Rows, Cols, i,j: integer;
    WorkSheet: OLEVariant;
    FData: OLEVariant;
    d: TDateTime;
begin
  //открываем книгу
  ExcelApp.Workbooks.Open(edFile.Text);
  //получаем активный лист
  WorkSheet:=ExcelApp.ActiveWorkbook.ActiveSheet;
  //определяем количество строк и столбцов таблицы
  Rows:=WorkSheet.UsedRange.Rows.Count;
  Cols:=WorkSheet.UsedRange.Columns.Count;
 
  //считываем данные всего диапазона
  FData:=WorkSheet.UsedRange.Value;
 
  StringGrid1.RowCount:=Rows;
  StringGrid1.ColCount:=Cols;
 
//засекаем время начала чтения
  d:=Now;
 
//выводим данные в таблицу
  for I := 0 to Rows-1 do
    for j := 0 to Cols-1 do
        StringGrid1.Cells[J,I]:=FData[I+1,J+1];
 
    Label2.Caption:='Время чтения всего листа: '+FormatDateTime('hh:mm:ss:zzz',
    Now()-d);
end;

Здесь мы ввели всего одну переменную FData типа Variant. В эту переменную мы прочитали за 1 операцию весь диапазон, занятый данными. После того как диапазон прочитан FData будет содержать матрицу, каждый элемент которой будет типом данных, определенным в Excel.

Смотрим на время выполнения операции:

Как видите, прирост скорости оказался колоссальным, учитывая даже то, что в счётчик попало время обновления StringGrid'а.

Здесь было бы уместно показать и обратный метод работы с Excel, т.е. запись данных на лист Excel с использованием вариантного массива.

Запись данных в Excel

В случае, если нам необходимо записать большой объем данных на лист Excel нам необходимо провести обратную операцию, т.е. вначале создать вариантный массив, затем записать в этот массив данные после чего записать весь массив одной операцией в Excel. Для примера я написал процедуру, которая считывает большой объем данных из StringGrid и записывает эти данные на второй лист открытой книги Excel:

procedure TForm16.WriteData;
var i,j: integer;
    FData: Variant;
    Sheet,Range: Variant;
begin
//создаем вариантный массив
  FData:=VarArrayCreate([1,StringGrid1.RowCount,1,StringGrid1.ColCount],varVariant);
//заполняем массив данными из StringGrid
  for i:=1 to VarArrayHighBound(FData,1) do
    for j:=1 to VarArrayHighBound(FData,2) do
      FData[i,j]:=StringGrid1.Cells[J-1,I-1];
{активируем второй лист книги}
//открываем книгу
ExcelApp.Workbooks.Open(edFile.Text);
//активируем
Sheet:=ExcelApp.ActiveWorkBook.Sheets[2];
Sheet.Activate;
//выделяем диапазон для вставки данных
Range:=Sheet.Range[Sheet.Cells[1,1],Sheet.Cells[VarArrayHighBound(FData,1),VarArrayHighBound(FData,2)]];
//вставляем данные
Range.Value:=FData;
//показываем окно Excel
ExcelApp.Visible:=True;
end;

Здесь мы вначале создаем двумерный вариантный массив, используя метод VarArrayCreate, после чего заполняем массив данным и передаем этот массив в Excel. Обратите внимание, что при записи в Excel не используются никакие циклы - запись происходит в 2 простых действия:

выделяем диапазон, используя в качестве границ диапазона первую и последнюю ячейки
присваиваем диапазону значение из массива.

Для полноты картины ниже на рисунке представлено значение счётчика, который отсчитал время от момента создания массива до активации приложения Excel включительно:

Естественно, что с ростом объема данных будет расти и время выполнения операции. Так, например, лист, содержащий 1000 строк и 256 столбцов с данными заполнялся около 7 секунд. Если для Вас такое время неприемлемо, то представленная выше процедура может быть немного ускорена использованием пары методов VarArrayLock() и VarArrayUnLock(), но при этом следует учитывать, что матрица FData будет транспонирована.

Что ещё стоит сказать по поводу чтения/записи данных в Excel? Наверное то, что предложенные выше методы работы в обязательном порядке требуют наличия установленного Excel на том компьютере где запускается Ваша программа. В связи с этим обстоятельством может потребоваться более универсальный способ работы с Excel. Здесь, опять же, может быть несколько вариантов работы, но я покажу, а точнее укажу только на один из них - с использованием библиотека XLSReadWrite.

Про эту библиотеку мне поведал один из читателей блога в комментарии как раз-таки к посту ""Работа с Excel в Delphi. Основы основ". Чтобы лишний раз Вас не переправлять на комментарий с примером использования этой библиотеки, я с разрешения GS (ник автора кода) просто опубликую здесь уже готовые примеры использования библиотеки XLSReadWrite:

Упрощенный пример для Delphi 7

var
  IntlXls: TXLSReadWriteII2;
  I, J: Integer;
 
begin
  // создаем объект
  IntlXls := TXLSReadWriteII2.Create(nil);
 
  // название книги
  IntlXls.Sheets[0].Name := " Название моего отчета ";
  // добавляем необходимое количество строк и колонок
  IntlXls.Sheets[0].Rows.AddIfNone(0, 10000);
  IntlXls.Sheets[0].Columns.AddIfNone(0, 100);
 
  // добавляем и заносим ширины ячеек (значение в пикселях)
  for I := 0 to 99 do
    IntlXls.Sheets[0].Columns[I].PixelWidth := 150;
  // заносим высоты строк (значение здесь не в пикселях, поэтому нужно корректировать)
  for I := 0 to 9999 do
    IntlXls.Sheets[0].Rows[I].Height := 20 * 14;
 
  // настраиваем
  for J := 0 to 9999 do
    for I := 0 to 99 do
    begin
      // заносим числовое значение
      // если нужно например занести строку, то использовать AsString
      IntlXls.Sheets[0].AsFloat[I, J] := J + I / 100;
 
      // выравнивание по горизонтали (доступно chaLeft, chaCenter, chaRight)
      IntlXls.Sheets[0].Cell[I, J].HorizAlignment := chaLeft;
 
      // выравнивание по вертикали (доступно cvaTop, cvaCenter, cvaBottom)
      IntlXls.Sheets[0].Cell[I, J].VertAlignment := cvaTop;
 
      // шрифт
      IntlXls.Sheets[0].Cell[I, J].FontName := " Arial ";
      IntlXls.Sheets[0].Cell[I, J].FontSize := 12;
      IntlXls.Sheets[0].Cell[I, J].FontStyle := [];
      IntlXls.Sheets[0].Cell[I, J].FontColor := TColorToClosestXColor(clBlue);
      IntlXls.Sheets[0].Cell[I, J].Rotation := 0;
      // жирное начертание
      with IntlXls.Sheets[0].Cell[I, J] do
        FontStyle := FontStyle + [xfsBold];
      // наклонное начертание
      with IntlXls.Sheets[0].Cell[I, J] do
        FontStyle := FontStyle + [xfsItalic];
      // цвет фона
      IntlXls.Sheets[0].Cell[I, J].FillPatternForeColor :=
        TColorToClosestXColor(clYellow);
 
      // бордюр слева (аналогично и остальные бордюры)
      IntlXls.Sheets[0].Cell[I, J].BorderLeftColor :=
        TColorToClosestXColor(clBlack);
      IntlXls.Sheets[0].Cell[I, J].BorderLeftStyle := cbsThin;
 
      // объединение ячеек (здесь объединяются две ячейки по горизонтали)
      if I = 49 then
        IntlXls.Sheets[0].MergedCells.Add(I, J, I + 1, J);
    end;
 
  IntlXls.SaveToFile(" c: \ demo.xls ");
  IntlXls.Free;
end;

Полный пример работы с библиотекой:

function ExportToExcelXls(var AFileName: string): Integer;
var
  IntlXls: TXLSReadWriteII2;
  IntlCol: Integer;
  IntlRow: Integer;
  IntlMainCol: Integer;
  IntlMainRow: Integer;
begin
  // инициализируем статус
  prgrbrStatus.Max := FLinkReport.RowCount;
  prgrbrStatus.Position := 0;
  pnlStatus.Visible := TRUE;
  pnlStatus.Refresh;
  // добавлено в конце имени файла расширение ".XLS"?
  if Length(AFileName) < 5 then
    // добавляем
    AFileName := AFileName + ".xls "
  else if AnsiCompareText(Copy(AFileName, Length(AFileName)- 3, 4), ".xls ") <> 0
  then
    // добавляем
    AFileName := AFileName + ".xls ";
  // файл уже существует?
  if FileExists(AFileName) then
    // спросим
    if Application.MessageBox
      (PChar(" Файл " " + AFileName + " " уже существует.Перезаписать ? "),
      " Внимание ", MB_TASKMODAL + MB_ICONQUESTION + MB_YESNO + MB_DEFBUTTON2)
      <> IDYES then
    // выходим
    begin
      // код ошибки
      Result := UNIRPT_GENERATE_ABORT;
 
      // выходим
      Exit;
    end; // if
  // создаем объект
  IntlXls := TXLSReadWriteII2.Create(nil);
  // все делаем защищаясь
  try
    // название книги
    IntlXls.Sheets[0].Name := FLinkReport.Caption;
    // добавляем необходимое количество строк и колонок
    IntlXls.Sheets[0].Rows.AddIfNone(0, FLinkReport.Cells.RowCount + 1);
    IntlXls.Sheets[0].Columns.AddIfNone(0, FLinkReport.Cells.ColCount + 1);
    // добавляем и заносим ширины ячеек
    for IntlCol := 0 to FLinkReport.Cells.ColCount - 1 do
      IntlXls.Sheets[0].Columns[IntlCol].PixelWidth :=
        FLinkReport.ColWidths[IntlCol];
    // заносим высоты строк
    for IntlRow := 0 to FLinkReport.Cells.RowCount - 1 do
      IntlXls.Sheets[0].Rows[IntlRow].Height := FLinkReport.RowHeights
        [IntlRow] * 14;
    // проходим по всем строкам
    for IntlRow := 0 to FLinkReport.Cells.RowCount - 1 do
    begin
      // проходим по всем колонкам
      for IntlCol := 0 to FLinkReport.Cells.ColCount - 1 do
      begin
        // определяем главную ячейку
        IntlMainCol := IntlCol + FLinkReport.Cells[IntlCol, IntlRow].Range.Left;
        IntlMainRow := IntlRow + FLinkReport.Cells[IntlCol, IntlRow].Range.Top;
        // заносим оформление
        with FLinkReport.Cells[IntlMainCol, IntlMainRow] do
        begin
          // главная ячейка?
          if (IntlMainCol = IntlCol) and (IntlMainRow = IntlRow) then
          // да, заносим текст и его оформление
          begin
            // значение
            try
              // если значение - число то заносим его как число
              IntlXls.Sheets[0].AsFloat[IntlCol, IntlRow] := StrToFloat(Value);
            except
              // иначе заносим его как строку
              IntlXls.Sheets[0].AsString[IntlCol, IntlRow] := Value;
            end;
 
            // выравнивание по горизонтали
            case HorizAlign of
              haLeft:
                // выравнивание слева
                IntlXls.Sheets[0].Cell[IntlCol, IntlRow].HorizAlignment
                  := chaLeft;
              haCenter:
                // выравнивание по центру
                IntlXls.Sheets[0].Cell[IntlCol, IntlRow].HorizAlignment :=
                  chaCenter;
              haRight:
                // выравнивание справа
                IntlXls.Sheets[0].Cell[IntlCol, IntlRow].HorizAlignment
                  := chaRight;
            end; // case
            // выравнивание по вертикали
            case VertAlign of
              vaTop:
                // выравнивание сверху
                IntlXls.Sheets[0].Cell[IntlCol, IntlRow].VertAlignment
                  := cvaTop;
              vaCenter:
                // выравнивание в центре
                IntlXls.Sheets[0].Cell[IntlCol, IntlRow].VertAlignment :=
                  cvaCenter;
              vaBottom:
                // выравнивание снизу
                IntlXls.Sheets[0].Cell[IntlCol, IntlRow].VertAlignment :=
                  cvaBottom;
            end; // case
            // шрифт
            IntlXls.Sheets[0].Cell[IntlCol, IntlRow].FontName := Font.Name;
            IntlXls.Sheets[0].Cell[IntlCol, IntlRow].FontSize := Font.Size;
            IntlXls.Sheets[0].Cell[IntlCol, IntlRow].FontCharset :=
              Font.Charset;
            IntlXls.Sheets[0].Cell[IntlCol, IntlRow].FontStyle := [];
            IntlXls.Sheets[0].Cell[IntlCol, IntlRow].FontColor :=
              TColorToClosestXColor(Font.Color);
            IntlXls.Sheets[0].Cell[IntlCol, IntlRow].Rotation := Font.Angle;
            // есть жирное начертание?
            if Font.IsBold then
              // есть
              with IntlXls.Sheets[0].Cell[IntlCol, IntlRow] do
                FontStyle := FontStyle + [xfsBold];
            // есть наклонное начертание?
            if Font.IsItalic then
              // есть
              with IntlXls.Sheets[0].Cell[IntlCol, IntlRow] do
                FontStyle := FontStyle + [xfsItalic];
            // цвет фона
            if Color <> clWindow then
              // цвет задан
              IntlXls.Sheets[0].Cell[IntlCol, IntlRow].FillPatternForeColor :=
                TColorToClosestXColor(Color);
          end // if
          else
            // просто активизируем ячейку (иначе ниже невозможно добавить бордюры)
            IntlXls.Sheets[0].AsString[IntlCol, IntlRow] := ";
 
          // бордюр слева есть?
          with Borders.Left do
            if LineHeight > 0 then
            // настраиваем
            begin
              // цвет
              IntlXls.Sheets[0].Cell[IntlCol, IntlRow].BorderLeftColor :=
                TColorToClosestXColor(Color);
              // толщина
              if LineHeight = 1 then
                // тонка
                IntlXls.Sheets[0].Cell[IntlCol, IntlRow].BorderLeftStyle
                  := cbsThin
              else if LineHeight in [1, 2] then
                // средняя толщина
                IntlXls.Sheets[0].Cell[IntlCol, IntlRow].BorderLeftStyle :=
                  cbsMedium
              else
                // толстая
                IntlXls.Sheets[0].Cell[IntlCol, IntlRow].BorderLeftStyle
                  := cbsHair;
            end; // if, with
          // бордюр сверху есть?
          with Borders.Top do
            if LineHeight > 0 then
            // настраиваем
            begin
              // цвет
              IntlXls.Sheets[0].Cell[IntlCol, IntlRow].BorderTopColor :=
                TColorToClosestXColor(Color);
              // толщина
              if LineHeight = 1 then
                // тонка
                IntlXls.Sheets[0].Cell[IntlCol, IntlRow].BorderTopStyle
                  := cbsThin
              else if LineHeight in [1, 2] then
                // средняя толщина
                IntlXls.Sheets[0].Cell[IntlCol, IntlRow].BorderTopStyle :=
                  cbsMedium
              else
                // толстая
                IntlXls.Sheets[0].Cell[IntlCol, IntlRow].BorderTopStyle
                  := cbsHair;
            end; // if, with
          // бордюр справа есть?
          with Borders.Right do
            if LineHeight > 0 then
            // настраиваем
            begin
              // цвет
              IntlXls.Sheets[0].Cell[IntlCol, IntlRow].BorderRightColor :=
                TColorToClosestXColor(Color);
              // толщина
              if LineHeight = 1 then
                // тонка
                IntlXls.Sheets[0].Cell[IntlCol, IntlRow].BorderRightStyle
                  := cbsThin
              else if LineHeight in [1, 2] then
                // средняя толщина
                IntlXls.Sheets[0].Cell[IntlCol, IntlRow].BorderRightStyle :=
                  cbsMedium
              else
                // толстая
                IntlXls.Sheets[0].Cell[IntlCol, IntlRow].BorderRightStyle
                  := cbsHair;
            end; // if, with
          // бордюр снизу есть?
          with Borders.Bottom do
            if LineHeight > 0 then
            // настраиваем
            begin
              // цвет
              IntlXls.Sheets[0].Cell[IntlCol, IntlRow].BorderBottomColor :=
                TColorToClosestXColor(Color);
              // толщина
              if LineHeight = 1 then
                // тонка
                IntlXls.Sheets[0].Cell[IntlCol, IntlRow].BorderBottomStyle
                  := cbsThin
              else if LineHeight in [1, 2] then
                // средняя толщина
                IntlXls.Sheets[0].Cell[IntlCol, IntlRow].BorderBottomStyle :=
                  cbsMedium
              else
                // толстая
                IntlXls.Sheets[0].Cell[IntlCol, IntlRow].BorderBottomStyle
                  := cbsHair;
            end; // if, with
          // объединение нужно?
          if ((Range.Width > 1) or (Range.Height > 1)) and
            ((IntlMainCol = IntlCol) and (IntlMainRow = IntlRow)) then
            // объединяем
            IntlXls.Sheets[0].MergedCells.Add(IntlCol, IntlRow,
              IntlCol + Range.Width - 1, IntlRow + Range.Height - 1);
          // пользователь нажал кнопку прерывания экспорта?
          if btnCancel.Tag = 2 then
            // да, выходим
            Break;
        end; // with
      end; // for
      // обновляем статус
      prgrbrStatus.Position := prgrbrStatus.Position + 1;
      Application.ProcessMessages;
      // пользователь нажал кнопку прерывания экспорта?
      if btnCancel.Tag = 2 then
        // да, выходим
        Break;
    end; // for
    // пользователь нажал кнопку прерывания экспорта?
    if btnCancel.Tag <> 2 then
    // нет
    begin
      // на левый верхний угол
      IntlXls.Sheet[0].TopRow := 0;
      IntlXls.Sheet[0].LeftCol := 0;
      IntlXls.Sheet[0].Selection.ActiveRow := 0;
      IntlXls.Sheet[0].Selection.ActiveCol := 0;
 
      // статус
      prgrbrStatus.Position := prgrbrStatus.Max;
      Application.ProcessMessages;
      // записываем в файл
      IntlXls.FileName := AFileName;
      IntlXls.Write;
      // все успешно
      Result := UNIRPT_OK;
 
    end // if
    else
      // да
      Result := UNIRPT_GENERATE_ABORT;
 
  finally
    // освобождаем память
    IntlXls.Free;
  end; // try..finally
end; // function ExportToExcelXls

Вот такой подробный пример предоставил нам GS в своем комментарии. Спасибо ему за это. Мне же в заключении остается только добавить и подчеркнуть, что самые правильные ответы и примеры к вопросам, касающимся работы с Excel содержаться в Справке для разработчиков в самом Excel и надо только воспользоваться поиском. Например, если вам довольно часто приходится перетаскивать данные из базы данных в Excel и в работе используется ADO, то специально для таких случаев в справке рассказывается про интересный метод объекта Range под названием CopyFromRecordset, а если вам надо разукрасить свою таблицу Excel в разные цвета и установить разные виды границ ячеек, то специально для таких случаев в справке приводится подробные перечень всех перечислителей Excel'я. В общем много чего есть - надо только этим воспользоваться и все получится. Ну, а если не получится, то милости прошу - задавайте вопросы здесь или на нашем форуме.