版权声明：本文为博主原创文章，遵循 CC 4.0 BY-SA 版权协议，转载请附上原文出处链接和本声明。
开发中经常有需要将Excel导入数据集的需要，但每张Excel的栏位都会不同，常规的做法有两种：
一、针对每一张Excel的栏位与数据集栏位位置在程序中写好，一一对应导入
二、针对每一张Excel的栏位与数据集栏位配置好应用参数
这两种方法都比较麻烦，很不灵活，所以我写了一个比较通用的方法，只要符合以下条件就可以直接使用：
1、Excel第一行是栏位标题，第二行开始是数据
2、应用程序数据集显示控件如(dbgrid,dxdbgrid等)名称与Excel首行标题名一致（顺序可以不同，数量也可以不同,如Excel的栏位：工号，姓名，年龄；显示控件栏位：姓名，工号，年龄，创建时间；这也是可以的)
以下为delphi 代码：-
procedure ExportExcelToCDS(mygrid: TdxDBGrid; filename: string);
-
var
-
i,j,row,col,ValidFNCount:integer;
-
MyExcel,Sheet:Variant;
-
str1,Prompt,ts:
string;
-
fieldnames:
array
of
string;
-
fieldList:
array
of
string;
-
ColIndex:
array
of Integer;
//Excel列序号
-
tmpcds:TDataSet;
-
tmpds:TDataSource;
-
CelValue:
string;
-
-
//搜索Excel的标题是否有对应到数据表中的字段
-
procedure SetFieldList;
-
var
-
t,t2,js:Integer;
-
str1,str2:
string;
-
begin
-
//搜索Excel中的有效字段
-
for t:=
1
to col
do
-
begin
-
str1:=StringReplace(Sheet.Cells[
1,t].Text,
' ',
'',[rfReplaceAll]);
-
for t2:=
0
to mygrid.ColumnCount-
1
do
-
begin
-
str2:=StringReplace(mygrid.Columns[t2].Caption,
' ',
'',[rfReplaceAll]);
-
if str1=str2
then
-
begin
-
ValidFNCount:=ValidFNCount+
1;
-
Break;
-
end;
-
end;
-
end;
-
SetLength(fieldList,ValidFNCount);
-
SetLength(ColIndex,ValidFNCount);
-
js:=
0;
-
for t:=
1
to col
do
-
begin
-
str1:=StringReplace(Sheet.Cells[
1,t].Text,
' ',
'',[rfReplaceAll]);
-
for t2:=
0
to mygrid.ColumnCount-
1
do
-
begin
-
str2:=StringReplace(mygrid.Columns[t2].Caption,
' ',
'',[rfReplaceAll]);
-
if str1=str2
then
-
begin
-
fieldList[js]:=mygrid.Columns[t2].FieldName;
//字段
-
fieldnames[js]:=mygrid.Columns[t2].Caption;
//字段显示名称
-
ColIndex[js]:=t;
//Excel列序号1...
-
js:=js+
1;
-
Break;
-
end;
-
end;
-
end;
-
end;
-
-
function CheckField:
string;
-
var
-
t:Integer;
-
str1:
string;
-
begin
-
for t:=
1
to col
do
-
begin
-
str1:=stringreplace(Sheet.Cells[
1,t].Text,
' ',
'',[rfReplaceAll]);
-
if str1=fieldnames[i]
then
-
begin
-
Break;
-
end;
-
Result:=str1;
-
end;
-
end;
-
//Excel列名至少有一个与grid中的字段相对应,是否不执行数据追加操作
-
function CheckFieldArray:Boolean;
-
var
-
t,t2:integer;
-
begin
-
t2:=
0;
-
for t:=
0
to col-
1
do
-
begin
-
if Trim(fieldList[t])<>
''
then
-
begin
-
t2:=
1;
-
Break;
-
end;
-
end;
-
if t2=
0
then
-
Result:=true
-
else
-
Result:=False;
-
end;
-
begin
-
if UpperCase(ExtractFileExt(filename))<>uppercase(
'.xlsx')
then
-
begin
-
ExportXLSToCDS(mygrid,filename);
-
Exit;
-
End;
-
//支持Excel2007格式
-
tmpcds:=mygrid.DataSource.DataSet;
-
tmpds:=mygrid.DataSource;
-
try
-
MyExcel:=CreateOleObject(
'Excel.Application');
-
except
-
ts:=
'请安装Excel';
-
MessageDlg(ts,mtWarning,[mbok],
0);
-
Exit;
-
end;
-
tmpcds.DisableControls;
-
SetLength(fieldnames,mygrid.ColumnCount);
-
try
-
for i:=
0
to mygrid.ColumnCount-
1
do
-
begin
-
if mygrid.Columns[i].Visible
then
-
fieldnames[i]:=stringreplace(mygrid.Columns[i].Caption,
' ',
'',[rfReplaceAll]);
-
end;
-
str1:=CheckField;
-
if str1<>
''
then
-
begin
-
MessageDlg(
'Excel中的'+str1+
'不正确',mtError,[mbOK],
0);
-
Exit;
-
end;
-
MyExcel.Workbooks.open(filename);
-
Sheet:=MyExcel.ActiveSheet;
-
row:=Sheet.UsedRange.Rows.Count;
//行数
-
col:=Sheet.UsedRange.Columns.Count;
//列数
-
if row<=
1
then
-
begin
-
Prompt:=
'Excel中至少有一条数据'+
#13+
'第一行是标题,其它行为数据行'+
#13+
'条件不符,操作取消';
-
MessageDlg(Prompt,mtWarning,[mbOK],
0);
-
Exit;
-
end;
-
if col<=
1
then
-
begin
-
Prompt:=
'Excel中至少有一列数据'+
#13+
'条件不符,操作取消';
-
MessageDlg(Prompt,mtWarning,[mbOK],
0);
-
Exit;
-
end;
-
SetFieldList;
-
if CheckFieldArray
then
-
begin
-
Prompt:=
'Excel中第一行中的列名至少有一个与列表中栏位相同'+
#13+
'条件不符,操作取消';
-
MessageDlg(Prompt,mtWarning,[mbOK],
0);
-
Exit;
-
end;
-
Screen.Cursor:=crHourGlass;
-
if
not tmpcds.Active
then
-
tmpcds.Open;
-
for i:=
2
to row
do
-
begin
-
Application.ProcessMessages;
-
CelValue:=Trim(Sheet.Cells[i,
0].Text);
-
if (CelValue=
'')
then
Continue;
-
tmpcds.Append;
-
for j:=
0
to ValidFNCount-
1
do
-
begin
-
Application.ProcessMessages;
-
CelValue:=Trim(Sheet.Cells[i,ColIndex[j]].Text);
-
try
-
//导入的数据文本不可以有公式，否则会出错
-
if (CelValue<>
'')
then
-
begin
-
case tmpcds.FieldByName(fieldList[j]).DataType
of
-
ftString:
-
tmpcds.FieldByName(fieldList[j]).AsString:=CelValue;
-
ftSmallint,ftInteger,ftWord,ftBoolean,ftFloat,ftCurrency,
-
ftBCD,ftBytes:
-
tmpcds.FieldByName(fieldList[j]).Value:=StrToFloat(CelValue);
-
ftDate,ftTime,ftDateTime:
-
tmpcds.FieldByName(fieldList[j]).AsDateTime:=Sheet.Cells[i,ColIndex[j]].Value;
-
end;
-
end;
-
except
-
on E:Exception
do
-
begin
-
MessageDlg(E.
Message+
#13+
'写入字段'+fieldList[j]+
'时出错,写入内容:'
-
+vartostr(CelValue)+
#13+
'Excel出错行列：'+inttostr(i)+
','+inttostr(j),mtError,[mbOK],
0);
-
end;
-
end;
-
end;
-
tmpcds.Post;
-
end;
-
finally
-
tmpcds.EnableControls;
-
MyExcel.Workbooks.close;
-
MyExcel.quit;
-
Sheet:=Unassigned;
-
MyExcel:=Unassigned;
-
Screen.Cursor:=crDefault;
-
MessageDlg(
'数据导入完毕',mtInformation,[mbOK],
0);
-
end;
-
end;
以上方法通过创建Excel对象导入其数据的，未使用第三方控件，其传入参数dxgrid可以改成您应用程序自已的控件类型，只要其带有datasource.dataset属性即可，比较灵活，但数据量比较大时可能比较慢，所以我做了一下改进，使用第三方控件读取Excel，再执行导入操作，这样速度非常快，以下是我改进的使用TcxSpreadSheet控件读取Excel的方法：
-
procedure ExportXLSToCDS(mygrid:TdxDBGrid;filename:string);
//将excel导入数据集
-
var
-
i,j,row,col,ValidFNCount:integer;
-
MyExcel:TcxSpreadSheet;
-
str1,Prompt:
string;
-
fieldnames:
array
of
string;
-
fieldList:
array
of
string;
-
ColIndex:
array
of Integer;
//Excel列序号
-
tmpcds:TDataSet;
-
tmpds:TDataSource;
-
CelValue:
string;
-
-
//搜索Excel的标题是否有对应到数据表中的字段
-
procedure SetFieldList;
-
var
-
t,t2,js:Integer;
-
str1,str2:
string;
-
begin
-
//搜索Excel中的有效字段
-
for t:=
0
to col-
1
do
-
begin
-
str1:=StringReplace(MyExcel.Sheet.getcellobject(t,
0).Text,
' ',
'',[rfReplaceAll]);
-
for t2:=
0
to mygrid.ColumnCount-
1
do
-
begin
-
str2:=StringReplace(mygrid.Columns[t2].Caption,
' ',
'',[rfReplaceAll]);
-
if str1=str2
then
-
begin
-
ValidFNCount:=ValidFNCount+
1;
-
Break;
-
end;
-
end;
-
end;
-
SetLength(fieldList,ValidFNCount);
-
SetLength(ColIndex,ValidFNCount);
-
js:=
0;
-
for t:=
0
to col-
1
do
-
begin
-
str1:=StringReplace(MyExcel.Sheet.getcellobject(t,
0).Text,
' ',
'',[rfReplaceAll]);
-
for t2:=
0
to mygrid.ColumnCount-
1
do
-
begin
-
str2:=StringReplace(mygrid.Columns[t2].Caption,
' ',
'',[rfReplaceAll]);
-
if str1=str2
then
-
begin
-
fieldList[js]:=mygrid.Columns[t2].FieldName;
//字段
-
fieldnames[js]:=mygrid.Columns[t2].Caption;
//字段显示名称
-
ColIndex[js]:=t;
//Excel列序号1...
-
js:=js+
1;
-
Break;
-
end;
-
end;
-
end;
-
end;
-
-
function CheckField:
string;
-
var
-
t:Integer;
-
str1:
string;
-
begin
-
for t:=
0
to col-
1
do
-
begin
-
str1:=stringreplace(MyExcel.Sheet.getcellobject(t,
0).Text,
' ',
'',[rfReplaceAll]);
-
if str1=fieldnames[i]
then
-
begin
-
Break;
-
end;
-
Result:=str1;
-
end;
-
end;
-
//Excel列名至少有一个与grid中的字段相对应,是否不执行数据追加操作
-
function CheckFieldArray:Boolean;
-
var
-
t,t2:integer;
-
begin
-
t2:=
0;
-
for t:=
0
to col-
1
do
-
begin
-
if Trim(fieldList[t])<>
''
then
-
begin
-
t2:=
1;
-
Break;
-
end;
-
end;
-
if t2=
0
then
-
Result:=true
-
else
-
Result:=False;
-
end;
-
-
begin
-
tmpcds:=mygrid.DataSource.DataSet;
-
tmpds:=mygrid.DataSource;
-
MyExcel:=TcxSpreadSheet.Create(
nil);
-
tmpcds.DisableControls;
-
SetLength(fieldnames,mygrid.ColumnCount);
-
try
-
for i:=
0
to mygrid.ColumnCount-
1
do
-
begin
-
if mygrid.Columns[i].Visible
then
-
fieldnames[i]:=stringreplace(mygrid.Columns[i].Caption,
' ',
'',[rfReplaceAll]);
-
end;
-
str1:=CheckField;
-
if str1<>
''
then
-
begin
-
MessageDlg(
'Excel中的'+str1+
'不正确',mtError,[mbOK],
0);
-
Exit;
-
end;
-
MyExcel.LoadFromFile(filename);
-
row:=MyExcel.Sheet.ContentRowCount;
//行数
-
col:=MyExcel.Sheet.ContentColCount;
//列数
-
if row<=
1
then
-
begin
-
Prompt:=
'Excel中至少有一条数据'+
#13+
'第一行是标题,其它行为数据行'+
#13+
'条件不符,操作取消';
-
MessageDlg(Prompt,mtWarning,[mbOK],
0);
-
Exit;
-
end;
-
if col<=
1
then
-
begin
-
Prompt:=
'Excel中至少有一列数据'+
#13+
'条件不符,操作取消';
-
MessageDlg(Prompt,mtWarning,[mbOK],
0);
-
Exit;
-
end;
-
SetFieldList;
-
if CheckFieldArray
then
-
begin
-
Prompt:=
'Excel中第一行中的列名至少有一个与列表中栏位相同'+
#13+
'条件不符,操作取消';
-
MessageDlg(Prompt,mtWarning,[mbOK],
0);
-
Exit;
-
end;
-
Screen.Cursor:=crHourGlass;
-
if
not tmpcds.Active
then
-
tmpcds.Open;
-
for i:=
1
to row-
1
do
-
begin
-
Application.ProcessMessages;
-
CelValue:=Trim(MyExcel.Sheet.getcellobject(ColIndex[
0],i).DisplayText);
-
if (CelValue=
'')
then
Continue;
-
tmpcds.Append;
-
for j:=
0
to ValidFNCount-
1
do
-
begin
-
Application.ProcessMessages;
-
CelValue:=MyExcel.Sheet.getcellobject(ColIndex[j],i).DisplayText;
-
try
-
//导入的数据文本不可以有公式，否则会出错
-
if VarToStr(CelValue)<>
''
then
-
begin
-
case tmpcds.FieldByName(fieldList[j]).DataType
of
-
ftString:
-
tmpcds.FieldByName(fieldList[j]).AsString:=CelValue;
-
ftSmallint,ftInteger,ftWord,ftBoolean,ftFloat,ftCurrency,
-
ftBCD,ftBytes:
-
tmpcds.FieldByName(fieldList[j]).Value:=StrToFloat(CelValue);
-
ftDate,ftTime,ftDateTime:
-
tmpcds.FieldByName(fieldList[j]).AsDateTime:=MyExcel.Sheet.getcellobject(ColIndex[j],i).DateTime;
-
end;
-
end;
-
except
-
on E:Exception
do
-
begin
-
MessageDlg(E.
Message+
#13+
'写入字段'+fieldList[j]+
'时出错,写入内容:'
-
+vartostr(CelValue)+
#13+
'Excel出错行列：'+inttostr(i)+
','+inttostr(j),mtError,[mbOK],
0);
-
end;
-
end;
-
end;
-
tmpcds.Post;
-
end;
-
finally
-
tmpcds.EnableControls;
-
Screen.Cursor:=crDefault;
-
FreeAndNil(MyExcel);
-
MessageDlg(
'数据导入完毕',mtInformation,[mbOK],
0);
-
end;
-
end;
845
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
