Excelをデータセットにインポートするための普遍的な方法

Universal Method Importing Excel Into Data Sets

多くの場合、開発中にExcelをデータセットにインポートする必要がありますが、Excelの各フィールドは異なります。 2つの一般的な慣行があります：
まず、プログラム内のExcelフィールドとデータセットフィールドの位置ごとに、1対1でインポートします。
次に、各Excelフィールドとデータセットフィールドのアプリケーションパラメータを構成します。
これらの2つの方法は面倒で柔軟性がないため、次の条件が満たされている限り直接使用できる、より一般的な方法を作成しました。

1、Excelの最初の行は列のタイトル、2番目の行はデータです

2、（dbgrid、dxdbgridなど）名前やExcelの最初の行のタイトル名などのアプリケーションデータセット表示コントロール（シーケンスは異なる場合があり、Excelフィールドなどの番号も異なる場合があります：ジョブ番号、名前、年齢表示コントロールフィールド：名前、ジョブ番号、年齢、作成時間これも可能です）

デルファイコードは次のとおりです。
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 column number tmpcds:TDataSet tmpds:TDataSource CelValue:string / / Search the title of Excel whether there is a corresponding field to the data table procedure SetFieldList var t,t2,js:Integer str1,str2:string begin / / Search for valid fields in 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//field Fieldnames[js]:=mygrid.Columns[t2].Caption//Field display name ColIndex[js]:=t//Excel column number 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 column name at least one corresponding to the field in the grid, whether to perform data append operation 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 / / Support Excel2007 format tmpcds:=mygrid.DataSource.DataSet tmpds:=mygrid.DataSource try MyExcel:=CreateOleObject('Excel.Application') except Ts:='Please install 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 (''+str1+' in Excel is incorrect', mtError, [mbOK], 0) Exit end MyExcel.Workbooks.open(filename) Sheet:=MyExcel.ActiveSheet Row:=Sheet.UsedRange.Rows.Count//Number of rows Col:=Sheet.UsedRange.Columns.Count//Number of columns if row<=1 then begin Prompt:='Excel has at least one piece of data '+#13+' The first line is the title, the other behavior data line '+#13+' conditions do not match, the operation is canceled' MessageDlg(Prompt,mtWarning,[mbOK],0) Exit end if col<=1 then begin Prompt:='Excel has at least one column of data '+#13+' conditions do not match, operation canceled ' MessageDlg(Prompt,mtWarning,[mbOK],0) Exit end SetFieldList if CheckFieldArray then begin Prompt:='At least one of the column names in the first row of Excel does not match the same column as the '+#13+' condition in the list, and the operation is canceled 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 / / Imported data text can not have a formula, otherwise it will be wrong 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+' error when writing field '+fieldList[j]+', write content: ' +vartostr(CelValue)+#13+'Excel error row: '+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 ('Data import completed', mtInformation, [mbOK], 0) end end

上記のメソッドは、サードパーティのコントロールを使用せずにExcelオブジェクトを作成してデータをインポートします。着信パラメーターdxgridは、datasource.datasetプロパティを持っている限り、アプリケーション独自の制御タイプに変更できますが、より柔軟性があります。ただし、データ量が比較的遅い可能性があるため、サードパーティのコントロールを使用してExcelを読み取り、インポート操作を実行することでいくつかの改善を行いました。これは非常に高速です。以下は、TcxSpreadSheetを使用してExcelを読み取るための改善された方法です。コントロール：

Procedure ExportXLSToCDS(mygrid:TdxDBGridfilename:string)//Import excel into the data set 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 column number tmpcds:TDataSet tmpds:TDataSource CelValue:string / / Search the title of Excel whether there is a corresponding field to the data table procedure SetFieldList var t,t2,js:Integer str1,str2:string begin / / Search for valid fields in 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//field Fieldnames[js]:=mygrid.Columns[t2].Caption//Field display name ColIndex[js]:=t//Excel column number 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 column name at least one corresponding to the field in the grid, whether to perform data append operation 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 (''+str1+' in Excel is incorrect', mtError, [mbOK], 0) Exit end MyExcel.LoadFromFile(filename) Row:=MyExcel.Sheet.ContentRowCount//Number of rows Col:=MyExcel.Sheet.ContentColCount//Number of columns if row<=1 then begin Prompt:='Excel has at least one piece of data '+#13+' The first line is the title, the other behavior data line '+#13+' conditions do not match, the operation is canceled' MessageDlg(Prompt,mtWarning,[mbOK],0) Exit end if col<=1 then begin Prompt:='Excel has at least one column of data '+#13+' conditions do not match, operation canceled ' MessageDlg(Prompt,mtWarning,[mbOK],0) Exit end SetFieldList if CheckFieldArray then begin Prompt:='At least one of the column names in the first row of Excel does not match the same column as the '+#13+' condition in the list, and the operation is canceled 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 / / Imported data text can not have a formula, otherwise it will be wrong 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+' error when writing field '+fieldList[j]+', write content: ' +vartostr(CelValue)+#13+'Excel error row: '+inttostr(i)+', '+inttostr(j), mtError,[mbOK],0) end end end tmpcds.Post end finally tmpcds.EnableControls Screen.Cursor:=crDefault FreeAndNil(MyExcel) MessageDlg ('Data import completed', mtInformation, [mbOK], 0) end end注：私が使用しているTcxSpreadSheetのバージョンは比較的低く、.xls形式のみをサポートしています。コードがわずかに変更されている限り、さまざまな開発ツールが上記の方法を使用します。