请问各位,如何Delphi实现快速将数据导出为EXECEL,我在书上按传统的方法不是很好,数据太多就速度较慢

解决方案 »

  1.   

    unit Unit1;interfaceuses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, StdCtrls, Excel2000, OleServer, OleCtnrs, DB, Grids, DBGrids,
      ADODB;type
      TForm1 = class(TForm)
        ADOConnection1: TADOConnection;
        ADOQuery1: TADOQuery;
        DBGrid1: TDBGrid;
        DataSource1: TDataSource;
        OleContainer1: TOleContainer;
        ExcelWorkbook1: TExcelWorkbook;
        ExcelWorksheet1: TExcelWorksheet;
        ExcelApplication1: TExcelApplication;
        Button1: TButton;
        procedure Button1Click(Sender: TObject);
      private
        { Private declarations }
      public
        { Public declarations }
      end;var
      Form1: TForm1;implementation{$R *.dfm}procedure TForm1.Button1Click(Sender: TObject);
    var
    i:integer;
    begin
    if fileexists('11.xls') then
    deletefile('11.xls');try
    excelapplication1.Connect ;
    except
    application.MessageBox('您的系统可能没有装EXCEL','提示',mb_okcancel);
    exit;
    end;//增加一个工作表
    excelapplication1.Workbooks.Add(null,0);
    excelworkbook1.ConnectTo(excelapplication1.Workbooks[1]);//增加一个工作页
    try
    excelworkbook1.Worksheets.Add(null,
    excelworkbook1.Worksheets[excelworkbook1.Worksheets.count],null,null,0);
    except
    application.MessageBox('创建失败','提示',mb_okcancel);
    exit;
    end;excelworksheet1.ConnectTo(excelworkbook1.Worksheets[1]as _worksheet);//加上表头也就是字段名for i:=0 to adoquery1.FieldCount-1 do
    begin
    excelworksheet1.Cells.Item[1,i+1].value:=adoquery1.Fields[i].DisplayLabel ;
    end;//开始导入数据adoquery1.First ;
    while not adoquery1.Eof do
    begin
    for i:=0 to adoquery1.FieldCount-1 do
    begin
    excelworksheet1.Cells.Item[adoquery1.RecNo+1,i+1].value:=adoquery1.Fields[i].AsString ;
    end;
    adoquery1.Next ;
    end;//保存记录try
    excelworksheet1.SaveAs(extractfilepath(paramstr(0))+'11.xls');
    except
    application.MessageBox('保存失败','提示',mb_okcancel);
    end;//所有都断开连接excelworksheet1.Disconnect ;
    excelworkbook1.Disconnect ;
    excelapplication1.Disconnect ;
    excelapplication1.Quit ;//把EXCEL文件打开olecontainer1.CreateLinkToFile(extractfilepath(paramstr(0))+'11.xls',false);
    olecontainer1.DoVerb(0);end;end.
      

  2.   

    用OLE调用Excel叫快速吗?
    晕死了。
    有没有试过2000行以上的数据导出?
    自己看看Excel文件的结构,自己写一个啦(我自己也写过,但只能导出到Excel 2.0格式的)
    或者到2ccc上下载一个。
      

  3.   

    用一个控件吧,ExcelExportPack这个专门是做到出的很好用,去盒子上下载一下就可以了!
      

  4.   

    1、目前来讲,最快的导出Excel文件的方法就是以二进制流的格式自己写,当然这也是最复杂的办法,因为必须相当的熟悉Excel的文件结构,说白了就是自己写一个简单的Excel,只是只有保存这个过程我目前写的这个至少目前看来还可以,基本包括了Excel的常用功能(字体、标题、页眉、单元格数据格式、颜色、边框、背景、页面设置、行高列宽)等,2000来行代码,导出5万行Excel不到1分钟2、另外一个比较快的方法就是通过ADOX,这个方法也很快,基本原理是通过数据库引擎模式进行操作,当然功能就没那么多,而且必须是数据集才可以导,至于速度,5万行记录也不到1分钟3、OLE模式,目前来说功能最强大的就是他了,Excel所有的功能它都有,基本原理就是相当于操作Excel
       OLE模式系统必须安装Excel,而且版本很多时候都有限制,各个版本并非完全兼容,目前最好使用Office2003   OLE的缺点也相当明显,那就是慢,尤其是多余2000行的时候,基本是无法忍受的,曾经测试过,目前主流配置电脑写入速度大约是200单元格/秒,如果写一个2000行20列的Excel文件大约需要2000*20/200=200秒,大约3分钟,当然这是基本理论值,实际情况下一般超过5分钟
       一个6000行80列的Excel文件在Core 2 2.0G/1G内存下30分钟后提示系统资源不足
       至于5万行Excel想都别想   至于具体测试数据,等那天没事的时候在服务器(HP 至强4核,双CPU,8G)上测试看看,估计不容乐观。
    但是如果读的话,目前基本只能用OLE模式,文件流模式或者ADOX模式(除非文件特别制作)基本不可行,MS把数据格式用一个HASH表存起来,格式搞的太复杂。
      

  5.   


    一个好消息,刚刚看到资料,几天前MS公开了Excel的文件格式,这样可以很轻松的以二进制方式进行写文件具体察看 http://www.microsoft.com/interop/docs/OfficeBinaryFormats.mspx就是不知道这份文档是否完整
      

  6.   

    {            记录集数据导出到组件 TLynDataSetToExcel V1.0 版本                 }
    {来源:该组件设计思想来自王寒松 CReport 中文报表组件,即直接用流写xls格式文件  }
    {特点:该组件直接按照Excel各Cell格式用流的形式写Excel文件,所以无需安装Excel服务}{-------------- by 天行者 [email protected] @2005.12.27 ------------------------}
     
    unit LynDataToXls;interfaceuses
      SysUtils, Classes, DB;type
      {表字段字典}
      TLynField=record
        id  : integer;   {序号}
        name     : string;    {字段名称}
        sName  : string;    {显示名称}
        width    : integer;   {宽度}
      end;
      {字段列表--------------------------------------------------------------------}
      TLynFieldList=record
       nField: integer;
        fields: array of TLynField;
      end;type
      TLynDataSetToExcel = Class(TComponent)
      private
        FMax: Word;
        FCol: Word;
        FRow: Word;
        FFields: TLynFieldList;
        FHeader: TStrings;
        FFooter: TStrings;
        FCaption: String;
        FDataSet: TDataSet;
        FStream: TStream;
        FBookMark: TBook;    procedure SetHeader(Value: TStrings);
        procedure SetFooter(Value: TStrings);    procedure IncColRow(NewRow: Boolean=FALSE);
        procedure WriteBlankCell(NewRow: Boolean=FALSE);
        procedure WriteFloatCell(const AValue: Double; NewRow: Boolean=FALSE);
        procedure WriteIntegerCell(const AValue: Integer; NewRow: Boolean=FALSE);
        procedure WriteStringCell(const AValue: String; NewRow: Boolean=FALSE);
        procedure WritePrefix;
        procedure WriteSuffix;
        procedure WriteHeader;
        procedure WriteColumnHead();
        procedure WriteCaption;
        procedure WriteFooter;
        procedure WriteDataCell;    procedure CalcMaxColumn();
        procedure SaveExcelStream(Stream: TStream);
      public
        procedure SaveExcelFile(FileName: String);
        constructor Create(AOwner: TComponent); override;
        destructor Destroy; override;
      published
       property Fields : TLynFieldList read FFields write FFields;
        property Header : TStrings read FHeader write SetHeader;
        property Footer : TStrings read FFooter write SetFooter;
        property Caption: String read FCaption write FCaption;
        property DataSet: TDataSet read FDataSet write FDataSet;
      end;procedure Register;implementationvar
      XlsBof   : array[0..5] of Word = ($809, 8, 0, $10, 0, 0);
      XlsEof   : array[0..1] of Word = ($0A, 00);
      XlsLabel : array[0..5] of Word = ($204, 0, 0, 0, 0, 0);
      XlsNumber: array[0..4] of Word = ($203, 14, 0, 0, 0);
      XlsRk    : array[0..4] Of Word = ($27E, 10, 0, 0, 0);
      XlsBlank : array[0..4] of Word = ($201, 6, 0, 0, $17);procedure TLynDataSetToExcel.SetHeader(Value: TStrings);
    begin
      if Value=nil then FHeader.Clear
      else FHeader.Assign(Value);
    end;procedure TLynDataSetToExcel.SetFooter(Value: TStrings);
    begin
      if Value=nil then FFooter.Clear
      else FFooter.Assign(Value);
    end;constructor TLynDataSetToExcel.Create(AOwner: TComponent);
    begin
      inherited Create(AOwner);
      FDataSet := nil;
      FHeader := TStringList.Create;
      FFooter := TStringList.Create;
    end;procedure TLynDataSetToExcel.IncColRow(NewRow: Boolean=FALSE);
    begin
      if (NewRow) or (FCol>=FMax-1) then
      begin
        FCol := 0;
        Inc(FRow);
      end
      else Inc(FCol);
    end;procedure TLynDataSetToExcel.WriteBlankCell(NewRow: Boolean=FALSE);
    Begin
      XlsBlank[2] := FRow;
      XlsBlank[3] := FCol;
      FStream.WriteBuffer(XlsBlank, sizeof(XlsBlank));
      IncColRow(NewRow);
    End;procedure TLynDataSetToExcel.WriteFloatCell(const AValue: Double; NewRow: Boolean=FALSE);
    Begin
      XlsNumber[2] := FRow;
      XlsNumber[3] := FCol;
      FStream.WriteBuffer(XlsNumber, sizeof(XlsNumber));
      FStream.WriteBuffer(AValue, 8);
      IncColRow(NewRow);
    End;procedure TLynDataSetToExcel.WriteIntegerCell(Const AValue: Integer; NewRow: Boolean=FALSE);
    var
      V: Integer;
    Begin
      XlsRk[2] := FRow;
      XlsRk[3] := FCol;
      FStream.WriteBuffer(XlsRk, sizeof(XlsRk));
      V := (AValue Shl 2) Or 2;
      FStream.WriteBuffer(V, 4);
      IncColRow(NewRow);
    End;procedure TLynDataSetToExcel.WriteStringCell(Const AValue: String; NewRow: Boolean=FALSE);
    Var
      L: Word;
    Begin
      L := Length(AValue);
      XlsLabel[1] := 8 + L;
      XlsLabel[2] := FRow;
      XlsLabel[3] := FCol;
      XlsLabel[5] := L;
      FStream.WriteBuffer(XlsLabel, sizeof(XlsLabel));
      FStream.WriteBuffer(Pointer(AValue)^, L);
      IncColRow(NewRow);
    end;{写入前缀}
    procedure TLynDataSetToExcel.WritePrefix;
    Begin
      FStream.WriteBuffer(XlsBof, sizeof(XlsBof));
    End;{写入后缀}
    procedure TLynDataSetToExcel.WriteSuffix;
    begin
      FStream.WriteBuffer(XlsEof, sizeof(XlsEof));
    end;procedure TLynDataSetToExcel.WriteHeader;
    var
      i: Integer;
    begin
      for i:=0 to FHeader.Count-1 do WriteStringCell(FHeader[i],TRUE);
    end;procedure TLynDataSetToExcel.WriteColumnHead();
    var
      n: Word;
    begin
    for n:=0 to FFields.nField-1 do
      begin
       WriteStringCell(FFields.Fields[n].sName);
      end;
    end;procedure TLynDataSetToExcel.WriteCaption;
    begin
      WriteStringCell(FCaption,TRUE);
    end;procedure TLynDataSetToExcel.WriteFooter;
    var
      i: Integer;
    begin
      for i:=0 to FFooter.Count-1 do WriteStringCell(FFooter[i],TRUE);
    end;procedure TLynDataSetToExcel.WriteDataCell;
    var
      n: Word;
      Field: TField;
    begin
      WritePrefix();                {写入 Excel 文件头}
      WriteHeader();                {写入题头}
      WriteCaption;                 {写入标题}
      WriteColumnHead();            {写入列标题}  FDataSet.DisableControls;
      FBookMark := FDataSet.GetBook;
      FDataSet.First;  
      while not FDataSet.Eof do
      begin
        for n:=0 to FFields.nField-1 do
        begin
         Field :=FDataSet.FindField(FFields.Fields[n].name);
          if Field<>nil then
          begin
           if Field.IsNull then WriteBlankCell
           else begin
             case Field.DataType of
               ftSmallint,
               ftInteger,
               ftWord,
               ftAutoInc,
               ftBytes,
                ftLargeint: WriteIntegerCell(Field.AsInteger);
               ftFloat,
               ftCurrency,
               ftBCD:     WriteFloatCell(Field.AsFloat);
                ftString,
                ftMemo,
                ftFixedChar,
                ftWideString,
                ftTime,
                ftDate: WriteStringCell(Field.AsString);
               else WriteStringCell('');
             end;
           end;
          end
          else begin
           WriteBlankCell();
          end;
        end;
        FDataSet.Next;
      end;
      WriteSuffix;
      WriteFooter;
      FDataSet.GotoBook(FBookMark);
      FDataSet.FreeBook(FBookMark);
      FDataSet.EnableControls;
    end;procedure TLynDataSetToExcel.CalcMaxColumn();
    begin
      FMax := FFields.nField;
    end;procedure TLynDataSetToExcel.SaveExcelStream(Stream: TStream);
    begin
      if FDataSet=nil then Exception.Create('未指定导出数据集错误!');
      FCol := 0;
      FRow := 0;
      CalcMaxColumn;
      FStream := Stream;
      WriteDataCell;
    end;procedure TLynDataSetToExcel.SaveExcelFile(FileName: String);
    var
      FileStream: TFileStream;
    begin
      if FileExists(FileName) then DeleteFile(FileName);
      FileStream := TFileStream.Create(FileName, fmCreate);
      try
        SaveExcelStream(FileStream);
      finally
        FileStream.Free;
      end;
    end;destructor TLynDataSetToExcel.Destroy;
    begin
      FHeader.Free;
      FFooter.Free;
      inherited Destroy;
    end;procedure Register;
    begin
      RegisterComponents('LynLib', [TLynDataSetToExcel]);
    end;end.