Método universal para importar Excel en conjuntos de datos

Universal Method Importing Excel Into Data Sets

A menudo es necesario importar Excel a un conjunto de datos durante el desarrollo, pero cada campo de Excel será diferente. Hay dos prácticas generales:
Primero, para cada campo de Excel y posición de campo de conjunto de datos en el programa, importación uno a uno
En segundo lugar, configure los parámetros de la aplicación para cada campo de Excel y campo de conjunto de datos.
Estos dos métodos son engorrosos e inflexibles, por lo que escribí un método más general que se puede usar directamente siempre que se cumplan las siguientes condiciones:

1, la primera línea de Excel es el título de la columna, la segunda línea son los datos

2, el control de visualización del conjunto de datos de la aplicación, como (dbgrid, dxdbgrid, etc.) el nombre y el nombre del título de la primera fila de Excel (la secuencia puede ser diferente, el número también puede ser diferente, como el campo de Excel: número de trabajo, nombre, control de visualización de edad campo: nombre, número de trabajo, edad, hora de creación, esto también es posible)



El siguiente es el código de Delphi:
|_+_|

El método anterior importa los datos creando un objeto de Excel sin utilizar un control de terceros.El parámetro entrante dxgrid se puede cambiar al tipo de control propio de su aplicación, siempre que tenga la propiedad datasource.dataset, es más flexible.Pero la cantidad de datos puede ser relativamente lenta, así que hice algunas mejoras, usé un control de terceros para leer Excel y luego realicé la operación de importación, esto es muy rápido, el siguiente es mi método mejorado para leer Excel usando TcxSpreadSheet control:





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 Nota: La versión de TcxSpreadSheet que uso es relativamente baja, solo admite el formato .xls. Varias herramientas de desarrollo utilizan los métodos anteriores siempre que el código se modifique ligeramente.