往excel里面写数据速度 怎么这么慢啊 急急急！！请高手指点

Question

有下面的一段代码 是我想把数据写到excel表里面
但是我发现只有1500条数据 居然花了2分钟才全部写到excel表里面 请问怎样才可以提高速度
好象PB里面很快的啊
请高手指点
procedure TF_ZK.SpeedButton2Click(Sender: TObject);
var ExcelApp,ExcelShe:olevariant;
i,j:integer;
filepath:string;
begin
filepath:=extractfilepath(Application.ExeName);
 if SaveDialog1.Execute then
  begin
    ExcelApp:=Createoleobject('Excel.Application');
    ExcelApp.workbooks.open(filepath+'库房库存表.xls');
    Excelapp.workbooks[1].sheets[1].name:='sheet1';
    ExcelShe:=ExcelApp.workbooks[1].sheets['sheet1'];
     ADOQuery1.Open;
        j:=2;
     ADOQuery1.First;
     while not ADOQuery1.Eof
      do
        begin
          for i:=2 to ADOQuery1.FieldCount+1 do
           begin
             ExcelShe.cells[j,i-1].value:=ADOQuery1.Fields[i-2].AsString;
           end;
           ADOQuery1.Next;
           inc(j);
         end;
           ExcelShe.saveas(SaveDialog1.FileName);
           ExcelApp.workbooks.close;
           messagedlg('保存成功，到您保存的位置去查看Excel表',mtinformation,[mbok],0);
  end;
end;

Answer 1

直接用写文本格式的试试看Field[0].AsString + tab + Fields[1].AsString 一行内的字段用 tab分开。然后再把文件后缀改成.xls

Answer 2

给你一段代码
这是我刚做的程序写的
没问题的
var
asheet,range:variant;
i,K,M,N,y :integer;
ls_FileName:string;
tsList  :TStringList;
s       :string;
begin
if SaveDialog1.Execute then begin
Screen.Cursor:=crHourGlass;
ls_FileName:=SaveDialog1.FileName;
ExcelApplication1.Visible[0]:=False;
ExcelApplication1.Workbooks.Add(xlWBATWorksheet,0);
asheet:=ExcelApplication1.Worksheets.Item[1];
i:=frmDataModule.QProject.FieldCount;
range:=asheet.range[asheet.cells[1,1],asheet.cells[1,i]];
range.merge;
range.HorizontalAlignment:=xlCenter;
range.Font.Size:=14;
frmDataModule.Tstatement.Locate('Flags',1,[]);
range.value:=Trim(frmDataModule.Tstatement.FieldByName('sqlName').Value);
for i:=0 to DBGrid1.Columns.Count-1 do
asheet.cells[2,i+1].value:=Trim(DBGrid1.Columns.Items[i].Title.Caption);
K:=1;
N:=DBGrid1.Columns.count;
I:=DBGrid1.DataSource.DataSet.RecordCount;
tsList:=TStringList.Create;
try
DBGrid1.DataSource.DataSet.first;
while not DBGrid1.DataSource.DataSet.Eof do
begin
                    s:='';
                    for y:=0 to n-1 do
                    begin
                        s:=s+Trim(DBGrid1.DataSource.DataSet.Fields[y].AsString)+#9;
                        Application.ProcessMessages;
                    end;
                    tsList.Add(s);
                    DBGrid1.DataSource.DataSet.next;
                end;
            Clipboard.AsText:=tsList.Text;
    finally
        tsList.Free;
    end;
    ExcelApplication1.Disconnect;
    asheet.cells[3,1].select;
    aSheet.Paste;
    range:=asheet.range[asheet.cells[2,1],asheet.cells[DBGrid1.DataSource.DataSet.RecordCount+2,DBGrid1.DataSource.DataSet.FieldCount]];
    range.select;
    range.borders.linestyle:=1;
    for i:=1 to DBGrid1.DataSource.DataSet.FieldCount do begin
    range:=asheet.range[asheet.cells[1,i],asheet.cells[DBGrid1.DataSource.DataSet.RecordCount,i]];
    range.EntireColumn.AutoFit;
    end;
    aSheet.Saveas(ls_FileName);
    MessageBox(Application.Handle,'数据导出完毕！','系统提示',MB_ICONINFORMATION or MB_OK);
    Screen.Cursor:=crDefault;
    ExcelApplication1.Quit;
    ExcelApplication1.Disconnect;
    aSheet:=Unassigned; //释放VARIANT变量
    DBGrid1.DataSource.DataSet.First;end;
end;

Answer 3

不过数据些好了最后不要忘记:ExcelApp.Visible:=true

Answer 4

可以直接把数据集赋值给excel，这样就可以不用循环了
以前写过一个，前阵子CSDN被封，帖子也没了

Answer 5

ExcelApp.visible：=false；
保存完再 true 的速度还是一样啊

Answer 6

我那种方法速度还可以
要不你就直接用存储过程
这是邹建写的一个存储过程
/*--数据导出EXCEL

导出查询中的数据到Excel,包含字段名,文件为真正的Excel文件
,如果文件不存在,将自动创建文件
,如果表不存在,将自动创建表
基于通用性考虑,仅支持导出标准数据类型
--邹建 2003.10--*//*--调用示例 p_exporttb @sqlstr='select * from 地区资料'
,@path='c:\',@fname='aa.xls',@sheetname='地区资料'
--*/
if exists (select * from dbo.sysobjects where id = object_id(N'[dbo].[p_exporttb]') and OBJECTPROPERTY(id, N'IsProcedure') = 1)
drop procedure [dbo].[p_exporttb]
GOcreate proc p_exporttb
@sqlstr sysname, --查询语句,如果查询语句中使用了order by ,请加上top 100 percent
@path nvarchar(1000), --文件存放目录
@fname nvarchar(250), --文件名
@sheetname varchar(250)='' --要创建的工作表名,默认为文件名
as 
declare @err int,@src nvarchar(255),@desc nvarchar(255),@out int
declare @obj int,@constr nvarchar(1000),@sql varchar(8000),@fdlist varchar(8000)--参数检测
if isnull(@fname,'')='' set @fname='temp.xls'
if isnull(@sheetname,'')='' set @sheetname=replace(@fname,'.','#')--检查文件是否已经存在
if right(@path,1)<>'\' set @path=@path+'\'
create table #tb(a bit,b bit,c bit)
set @sql=@path+@fname
insert into #tb exec master..xp_fileexist @sql--数据库创建语句
set @sql=@path+@fname
if exists(select 1 from #tb where a=1)
set @constr='DRIVER={Microsoft Excel Driver (*.xls)};DSN='''';READONLY=FALSE'
     +';CREATE_DB="'+@sql+'";DBQ='+@sql
else
set @constr='Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties="Excel 5.0;HDR=YES'
+';DATABASE='+@sql+'"'--连接数据库
exec @err=sp_oacreate 'adodb.connection',@obj out
if @err<>0 goto lberrexec @err=sp_oamethod @obj,'open',null,@constr
if @err<>0 goto lberr--创建表的SQL
declare @tbname sysname
set @tbname='##tmp_'+convert(varchar(38),newid())
set @sql='select * into ['+@tbname+'] from('+@sqlstr+') a'
exec(@sql)select @sql='',@fdlist=''
select @fdlist=@fdlist+','+a.name
,@sql=@sql+',['+a.name+'] '
+case when b.name in('char','nchar','varchar','nvarchar') then
 'text('+cast(case when a.length>255 then 255 else a.length end as varchar)+')'
when b.name in('tynyint','int','bigint','tinyint') then 'int'
when b.name in('smalldatetime','datetime') then 'datetime'
when b.name in('money','smallmoney') then 'money'
else b.name end
FROM tempdb..syscolumns a left join tempdb..systypes b on a.xtype=b.xusertype
where b.name not in('image','text','uniqueidentifier','sql_variant','ntext','varbinary','binary','timestamp')
and a.id=(select id from tempdb..sysobjects where name=@tbname)
select @sql='create table ['+@sheetname
+']('+substring(@sql,2,8000)+')'
,@fdlist=substring(@fdlist,2,8000)exec @err=sp_oamethod @obj,'execute',@out out,@sql
if @err<>0 goto lberrexec @err=sp_oadestroy @obj--导入数据
set @sql='openrowset(''MICROSOFT.JET.OLEDB.4.0'',''Excel 5.0;HDR=YES
;DATABASE='+@path+@fname+''',['+@sheetname+'$])'exec('insert into '+@sql+'('+@fdlist+') select '+@fdlist+' from ['+@tbname+']')set @sql='drop table ['+@tbname+']'
exec(@sql)
returnlberr:
exec sp_oageterrorinfo 0,@src out,@desc out
lbexit:
select cast(@err as varbinary(4)) as 错误号
,@src as 错误源,@desc as 错误描述
select @sql,@constr,@fdlist

Answer 7

可以这样试试：
就是先把数据写入到一个容器（如Memo），然后拷贝到粘贴板，直接复制到Execl中，我想这样应该比较快吧！！

Answer 8

(2004-08-15 10:06:31)   星际飞尘(9024353)   托福啊，就您的问题提个问题，别见怪
在Form中加入OpenPictureDialog对话框时，在程序设计阶段双击该控件能预览图像，而Run后确不能预览，而且死机?请问版主，这是为什么呢? 这是关于Delphi的问题