Excel, OLE, Formatierung beschleunigen

[hoika]

Hallo,

und hier die Lösung


Habe ich im Internet Range, Union entdeckt (der Artikel von Dirk Selig).

Und mit variabler Anzahl sieht das etwa so aus.

Delphi-Quellcode:

      
var
  XLApp,
  Sheet,
  Range1, 
  Range2: OleVariant;
  

      DoubleColumnList:= TDoubleColumnList.Create;
      try
        Grid_GetDoubleColumns(AGrid, DoubleColumnList);

        sFormat:= 'Standard';

        bFormatError:= False;

        try
          if DoubleColumnList.Count>0 then
          begin
            try
             { first range }
              DoubleColumnItem:= DoubleColumnList[0];
              sRef_Start:= RefToCell(DoubleColumnItem.iCol+1,
                                     DoubleColumnItem.iRowStart+1);
              sRef_End  := RefToCell(DoubleColumnItem.iCol+1,
                                     DoubleColumnItem.iRowEnd+1);
              Range1:= Sheet.Range[sRef_Start,sRef_End];

             { all others ranges are added via union }
              for iDoubleColumnItem:= 1 to DoubleColumnList.Count-1 do
              begin
                DoubleColumnItem:= DoubleColumnList[iDoubleColumnItem];
                sRef_Start:= RefToCell(DoubleColumnItem.iCol+1,
                                       DoubleColumnItem.iRowStart+1);
                sRef_End  := RefToCell(DoubleColumnItem.iCol+1,
                                       DoubleColumnItem.iRowEnd+1);
                Range2:= Sheet.Range[sRef_Start,sRef_End];
                Range1:= XLApp.Union(Range1,Range2);
              end;
              Range1.NumberFormat:= sFormat;
            except
              bFormatError:= True;
            end;

            if bFormatError then
            begin
              bFormatError:= False;
              sFormat:= 'General';
              try
                Range1.NumberFormat:= sFormat;
              except
                bFormatError:= True;
              end;
            end;

            if bFormatError=False then
            begin
              for iDoubleColumnItem:= 0 to DoubleColumnList.Count-1 do
              begin
                DoubleColumnItem:= DoubleColumnList[iDoubleColumnItem];

                for iRow:= DoubleColumnItem.iRowStart to DoubleColumnItem.iRowEnd do
                begin
                  if TryStrToFloat(AGrid.Cells[DoubleColumnItem.iCol,iRow], dFloat) then
                  begin
                    sRef:= RefToCell(DoubleColumnItem.iCol+1, iRow+1);
                    Sheet.Range[sRef,sRef].Value:= dFloat;
                  end;
                end;
              end;
            end;
          end;  { if sRefStr<>'' then }
        except
        end;
      finally
        DoubleColumnList.Free;
      end;

und hier noch die Hilfs-Routine

Delphi-Quellcode:

type
  TBusinessObject = class;
  TBusinessObjectList=class(TList);

type
  TDoubleColumnItem = class(TBusinessObject)
    public
      iCol      : Integer;
      iRowStart : Integer;
      iRowEnd   : Integer;
  end;  { TDoubleColumnItem }
type
  TDoubleColumnList = class(TBusinessObjectList)

procedure Grid_GetDoubleColumns(const theGrid: TStringGrid;
  theDoubleColumnList: TDoubleColumnList);

  procedure Add2List(const theCol, theRowStart, theRowEnd: Integer);
  var
    DoubleColumnItem: TDoubleColumnItem;
  begin
    DoubleColumnItem:= TDoubleColumnItem.Create;
    DoubleColumnItem.iCol      := theCol;
    DoubleColumnItem.iRowStart := theRowStart;
    DoubleColumnItem.iRowEnd   := theRowEnd;
    theDoubleColumnList.Add(DoubleColumnItem);
  end;

var
  iRow        : Integer;
  iCurCol     : Integer;
  iCurRow     : Integer;
  bInRange    : Boolean;
  iRangeStart : Integer;
  iRangeEnd   : Integer;
  dDouble     : Double;
begin
  theDoubleColumnList.ClearList;

  iRangeStart := 0;
  iRangeEnd   := 0;

  for iCurCol:= 0 to theGrid.ColCount-1 do
  begin
    bInRange := False;
    iCurRow  := -1;
    for iRow:= 0 to theGrid.RowCount-1 do
    begin
      Inc(iCurRow);

      if TryStrToFloat(theGrid.Cells[iCurCol,iCurRow], dDouble) then
      begin
       { cell is a double }
        if not bInRange then
        begin
         { new range begins }
          iRangeStart := iCurRow;
          iRangeEnd   := iCurRow;
          bInRange    := True;
        end
        else
        begin
         { range is updated }
          iRangeEnd:= iCurRow;
        end;
      end
      else
      begin
       { cell is not double
         if we are in a range, we add this range to the list }
        if bInRange then
        begin
          Add2List(iCurCol, iRangeStart, iRangeEnd);
          bInRange:= False;
        end;
      end;
    end;

    if bInRange then
    begin
      Add2List(iCurCol, iRangeStart, iRangeEnd);
    end;
  end;  { for iCurCol:= 0 to theGrid.ColCount-1 do }
end;  { Grid_GetDoubleColumns }

Jetzt geht der Export ratz fatz *freu


Heiko