由于系统使用导出的格式是csv,但是如果数字的长度太长的话,用excle打开会用科学技术法自动截断了。所以开发了一个转换程序。
- unit Unit1;
-
-
-
-
interface
-
-
-
- uses
-
- Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
-
- Dialogs, StdCtrls, ExtCtrls, ComCtrls, ComObj, StrUtils, WinSkinData,
-
- WinSkinStore, Gauges, ShellApi, ClipBrd;
-
-
-
- type
-
-
TForm1 = class(TForm)
-
- OpenDialog1: TOpenDialog;
-
- SaveDialog1: TSaveDialog;
-
- Panel1: TPanel;
-
- Edit1: TEdit;
-
- Edit2: TEdit;
-
- Button1: TButton;
-
- Button2: TButton;
-
- Button3: TButton;
-
- StatusBar1: TStatusBar;
-
- SkinData1: TSkinData;
-
- Timer1: TTimer;
-
- Gauge1: TGauge;
-
- progressBar: TProgressBar;
-
- procedure Button1Click(Sender: TObject);
-
- procedure Button2Click(Sender: TObject);
-
- procedure Button3Click(Sender: TObject);
-
- procedure FormPaint(Sender: TObject);
-
- procedure StatusBar1DrawPanel(StatusBar: TStatusBar;
-
-
Panel: TStatusPanel; const Rect: TRect);
-
- procedure FormCreate(Sender: TObject);
-
- procedure Timer1Timer(Sender: TObject);
-
-
private
-
-
progressBarRect:TRect;
-
-
public
-
- { Public declarations }
-
- procedure DropFiles(var Message: TMessage); message WM_DropFiles;
-
- end;
-
-
-
- var
-
- Form1: TForm1;
-
-
-
- implementation
-
-
-
- {$R *.dfm}
-
-
-
- procedure TForm1.DropFiles(var Message: TMessage);
-
- var
-
- i,l: Integer;
-
-
p: array[0..254] of Char;
-
- s: String;
-
- begin
-
-
i := DragQueryFile(Message.wParam, $FFFFFFFF, nil, 0);
-
-
for i := 0 to i - 1 do begin
-
-
DragQueryFile(Message.wParam, i, p, 255);
-
-
-
- s := StrPas(p);
-
-
l := Pos('.csv',s);
-
-
if (l > 0) then
-
- Edit1.Text := StrPas(p)
-
-
else
-
-
ShowMessage('请选择csv文件!');
-
- end;
-
- end;
-
-
-
- procedure TForm1.Button1Click(Sender: TObject);
-
- begin
-
-
StatusBar1.Panels[0].Text :='';
-
- OpenDialog1.Execute;
-
- Edit1.Text := OpenDialog1.FileName;
-
- end;
-
-
-
- procedure TForm1.Button2Click(Sender: TObject);
-
- begin
-
-
StatusBar1.Panels[0].Text:='';
-
- SaveDialog1.Execute;
-
- Edit2.Text := SaveDialog1.FileName;
-
- end;
-
-
-
- procedure TForm1.Button3Click(Sender: TObject);
-
- var
-
- Excel,WorkBook,xlQuery,A:Variant;
-
- f:TextFile;
-
- i,j,k,b,nLen:integer;
-
- s,xlsFile:string;
-
- pc:PChar;
-
- StepCount : Integer;
-
- vSL: TStringList;
-
- begin
-
-
try
-
-
if not FileExists(Edit1.Text) then
-
- begin
-
-
StatusBar1.Panels[0].Text:='请选择CSV文件!!!!!!!';
-
- exit;
-
- end;
-
- xlsFile := Edit1.Text;
-
-
xlsFile := AnsiReplaceText(xlsFile,'.csv','.xls');
-
-
if xlsFile = '' then
-
- begin
-
-
StatusBar1.Panels[0].Text:='请选择另存为Excel!!!!!!!';
-
- Exit;
-
- end;
-
-
-
-
-
- vSL := TStringList.Create;
-
-
-
- vSL.LoadFromFile(Edit1.Text);
-
-
try
-
-
Excel:=CreateOleObject('Excel.Application');
-
-
WorkBook:=CreateOleobject('Excel.Sheet');
-
- except
-
-
ShowMessage('您的机器里未安装Microsoft Excel.');
-
- Exit;
-
- end;
-
-
-
-
-
-
StepCount:=vSL.Count;
-
-
timer1.Enabled:=true;
-
-
with progressBar do
-
- begin
-
-
-
- Top:=ProgressBarRect.Top;
-
- Left:=ProgressBarRect.Left;
-
- Width:=ProgressBarRect.Right-ProgressBarRect.Left;
-
- Height:=ProgressBarRect.Bottom-ProgressBarRect.Top;
-
-
Parent:=StatusBar1;
-
-
Visible:=True;
-
-
Min:=0;
-
-
Max:=StepCount div 300;
-
-
Step:=1;
-
- end;
-
-
-
- WorkBook := Excel.workbooks.add;
-
-
Excel.worksheets[1].activate;
-
-
Excel.Visible:=false;
-
-
-
-
-
-
s:=vSL[0];
-
- pc := PChar(s);
-
-
k:=0;
-
-
b:=1;
-
-
j:=1;
-
- nLen := strlen(pc);
-
-
while k<nLen do
-
- begin;
-
-
if pc[k] = ',' then
-
- begin
-
- inc(j);
-
- end;
-
- inc(k);
-
- end;
-
-
-
-
A:=VarArrayCreate([0,j],varVariant);
-
-
for i:=0 to j do
-
-
A[i]:=2;
-
-
-
-
xlQuery := Excel.worksheets[1].QueryTables.Add('TEXT;'+Edit1.Text,Excel.worksheets[1].Range['A1']);
-
-
-
- xlQuery.FieldNames := True;
-
- xlQuery.RowNumbers := False;
-
- xlQuery.FillAdjacentFormulas := False;
-
- xlQuery.PreserveFormatting := True;
-
- xlQuery.RefreshOnFileOpen := False;
-
-
-
- xlQuery.SavePassword := False;
-
- xlQuery.SaveData := True;
-
- xlQuery.AdjustColumnWidth := True;
-
-
xlQuery.RefreshPeriod := 0;
-
- xlQuery.TextFilePromptOnRefresh := False;
-
-
xlQuery.TextFilePlatform := 936;
-
-
xlQuery.TextFileStartRow := 1;
-
-
-
-
-
- xlQuery.TextFileConsecutiveDelimiter := False;
-
- xlQuery.TextFileTabDelimiter := False;
-
- xlQuery.TextFileSemicolonDelimiter := False;
-
- xlQuery.TextFileCommaDelimiter := True;
-
- xlQuery.TextFileSpaceDelimiter := False;
-
- xlQuery.TextFileColumnDataTypes := A;
-
- xlQuery.TextFileTrailingMinusNumbers := True;
-
- xlQuery.Refresh;
-
-
if FileExists(xlsFile) then
-
- DeleteFile(xlsFile);
-
-
-
- WorkBook.SaveAs(xlsFile);
-
-
StatusBar1.Panels[0].Text:='转换成功!!!!!!!';
-
-
progressBar.Visible:=false;
-
-
finally
-
-
if vSL<>nil then
-
- vSL.Free;
-
-
if not VarIsEmpty(WorkBook) then WorkBook.close;
-
-
if not VarIsEmpty(Excel) then Excel.quit;
-
-
-
-
timer1.Enabled:=false;
-
- end;
-
- end;
-
-
-
- procedure TForm1.FormPaint(Sender: TObject);
-
- begin
-
-
StatusBar1.Panels[0].Text:='中国建设银行版权所有..........';
-
-
-
- end;
-
-
-
- procedure TForm1.StatusBar1DrawPanel(StatusBar: TStatusBar;
-
-
Panel: TStatusPanel; const Rect: TRect);
-
- begin
-
- progressBarRect:=Rect;
-
- end;
-
-
-
- procedure TForm1.FormCreate(Sender: TObject);
-
- begin
-
- DragAcceptFiles(Handle, True);
-
- end;
-
-
-
- procedure TForm1.Timer1Timer(Sender: TObject);
-
- begin
-
- progressBar.Stepit;
-
-
-
-
-
- end;
-
-
-
- end.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ComCtrls, ComObj, StrUtils, WinSkinData,
WinSkinStore, Gauges, ShellApi, ClipBrd;
type
TForm1 = class(TForm)
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
Panel1: TPanel;
Edit1: TEdit;
Edit2: TEdit;
Button1: TButton;
Button2: TButton;
Button3: TButton;
StatusBar1: TStatusBar;
SkinData1: TSkinData;
Timer1: TTimer;
Gauge1: TGauge;
progressBar: TProgressBar;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure StatusBar1DrawPanel(StatusBar: TStatusBar;
Panel: TStatusPanel; const Rect: TRect);
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
progressBarRect:TRect; // 进度条组件的尺寸
public
{ Public declarations }
procedure DropFiles(var Message: TMessage); message WM_DropFiles;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.DropFiles(var Message: TMessage);
var
i,l: Integer;
p: array[0..254] of Char;
s: String;
begin
i := DragQueryFile(Message.wParam, $FFFFFFFF, nil, 0);
for i := 0 to i - 1 do begin
DragQueryFile(Message.wParam, i, p, 255);
//ShowMessage(StrPas(p));
s := StrPas(p);
l := Pos('.csv',s);
if (l > 0) then
Edit1.Text := StrPas(p)
else
ShowMessage('请选择csv文件!');
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
StatusBar1.Panels[0].Text :='';
OpenDialog1.Execute;
Edit1.Text := OpenDialog1.FileName;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
StatusBar1.Panels[0].Text:='';
SaveDialog1.Execute;
Edit2.Text := SaveDialog1.FileName;
end;
procedure TForm1.Button3Click(Sender: TObject);
var
Excel,WorkBook,xlQuery,A:Variant;
f:TextFile;
i,j,k,b,nLen:integer;
s,xlsFile:string;
pc:PChar;
StepCount : Integer;
vSL: TStringList;
begin
try
if not FileExists(Edit1.Text) then
begin
StatusBar1.Panels[0].Text:='请选择CSV文件!!!!!!!';
exit;
end;
xlsFile := Edit1.Text;
xlsFile := AnsiReplaceText(xlsFile,'.csv','.xls');
if xlsFile = '' then
begin
StatusBar1.Panels[0].Text:='请选择另存为Excel!!!!!!!';
Exit;
end;
//AssignFile(f,Edit1.Text);
//Reset(f);
vSL := TStringList.Create;
//vSL.Delimiter=',';
vSL.LoadFromFile(Edit1.Text);
try
Excel:=CreateOleObject('Excel.Application');
WorkBook:=CreateOleobject('Excel.Sheet');
except
ShowMessage('您的机器里未安装Microsoft Excel.');
Exit;
end;
//动态创建进度条组件progressBar
StepCount:=vSL.Count; // 循环的总数目
timer1.Enabled:=true;
with progressBar do
begin
// 先确定进度条组件的尺寸和位置
Top:=ProgressBarRect.Top;
Left:=ProgressBarRect.Left;
Width:=ProgressBarRect.Right-ProgressBarRect.Left;
Height:=ProgressBarRect.Bottom-ProgressBarRect.Top;
Parent:=StatusBar1; // parent属性设置为状态栏组件
Visible:=True; // 使进度条可见
Min:=0;// 设定进度条的范围和步长
Max:=StepCount div 300;
Step:=1;
end;
//pb.Visible := true;
WorkBook := Excel.workbooks.add;
Excel.worksheets[1].activate;
Excel.Visible:=false;
// Clipboard.AsText:=vSL.Text;
//计算有多少列
s:=vSL[0];
pc := PChar(s);
k:=0;
b:=1;
j:=1;
nLen := strlen(pc);
while k<nLen do
begin;
if pc[k] = ',' then
begin
inc(j);
end;
inc(k);
end;
A:=VarArrayCreate([0,j],varVariant);
for i:=0 to j do
A[i]:=2;
xlQuery := Excel.worksheets[1].QueryTables.Add('TEXT;'+Edit1.Text,Excel.worksheets[1].Range['A1']);
//xlQuery.Name := '';
xlQuery.FieldNames := True;
xlQuery.RowNumbers := False;
xlQuery.FillAdjacentFormulas := False;
xlQuery.PreserveFormatting := True;
xlQuery.RefreshOnFileOpen := False;
//xlQuery.RefreshStyle := 'xlInsertDeleteCells';
xlQuery.SavePassword := False;
xlQuery.SaveData := True;
xlQuery.AdjustColumnWidth := True;
xlQuery.RefreshPeriod := 0;
xlQuery.TextFilePromptOnRefresh := False;
xlQuery.TextFilePlatform := 936;
xlQuery.TextFileStartRow := 1;
//xlQuery.TextFileParseType := 'xlDelimited';
//xlQuery.TextFileTextQualifier := 'xlTextQualifierDoubleQuote';
xlQuery.TextFileConsecutiveDelimiter := False;
xlQuery.TextFileTabDelimiter := False;
xlQuery.TextFileSemicolonDelimiter := False;
xlQuery.TextFileCommaDelimiter := True;
xlQuery.TextFileSpaceDelimiter := False;
xlQuery.TextFileColumnDataTypes := A;
xlQuery.TextFileTrailingMinusNumbers := True;
xlQuery.Refresh;
if FileExists(xlsFile) then
DeleteFile(xlsFile);
// Excel.worksheets[1].Paste;
WorkBook.SaveAs(xlsFile);
StatusBar1.Panels[0].Text:='转换成功!!!!!!!';
progressBar.Visible:=false;
finally
if vSL<>nil then
vSL.Free;
if not VarIsEmpty(WorkBook) then WorkBook.close;
if not VarIsEmpty(Excel) then Excel.quit;
//if not VarIsEmpty(A) then varfree(A);
timer1.Enabled:=false;
end;
end;
procedure TForm1.FormPaint(Sender: TObject);
begin
StatusBar1.Panels[0].Text:='中国建设银行版权所有..........';
end;
procedure TForm1.StatusBar1DrawPanel(StatusBar: TStatusBar;
Panel: TStatusPanel; const Rect: TRect);
begin
progressBarRect:=Rect;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
DragAcceptFiles(Handle, True);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
progressBar.Stepit;
//Application.ProcessMessages;
//Sleep(ProgressBar.Position);
end;
end.
原来使用的是
-
for i:=1 to StepCount do
-
- begin
-
-
-
-
progressBar.Stepit;
-
- s:=vSL[i-1];
-
- pc := PChar(s);
-
- k:=0;
-
- b:=1;
-
- j:=0;
-
- nLen := strlen(pc);
-
-
while k<nLen do
-
- begin;
-
-
if pc[k] = ',' then
-
- begin
-
- inc(j);
-
-
Excel.cells[i,j].NumberFormat:='@';
-
- Excel.cells[i,j].value:=Copy(s,b,k-b+1);
-
- b:=k+2;
-
- end;
-
- inc(k);
-
- end;
-
- inc(j);
-
-
Excel.cells[i,j].NumberFormat:='@';
-
- Excel.cells[i,j].value:=Copy(s,b,k-b+1);
-
- end;
-
- 上面的代码是遍历整个文件,判断是否有逗号,然后对每个格子插入数据。这样做的效率很低,
- 3千多行的数据转换用了5分钟。后来使用vba,先用excle录制了一段外部数据导入的宏。
-
<PRE class=vb.net name="code">Sub Macro3()
-
- '
-
- ' Macro3 Macro
-
- ' 宏由 ZHL 录制,时间: 2008-7-3
-
- '
-
-
-
- '
-
- Cells.Select
-
- With ActiveSheet.QueryTables.Add(Connection:= _
-
-
"TEXT;C:/Documents and Settings/zhl/桌面/200807021528053658.csv", Destination:= _
-
-
Range("A1"))
-
-
.Name = "200807021528053658_1"
-
- .FieldNames = True
-
- .RowNumbers = False
-
- .FillAdjacentFormulas = False
-
- .PreserveFormatting = True
-
- .RefreshOnFileOpen = False
-
- .RefreshStyle = xlInsertDeleteCells
-
- .SavePassword = False
-
- .SaveData = True
-
- .AdjustColumnWidth = True
-
- .RefreshPeriod = 0
-
- .TextFilePromptOnRefresh = False
-
- .TextFilePlatform = 936
-
- .TextFileStartRow = 1
-
- .TextFileParseType = xlDelimited
-
- .TextFileTextQualifier = xlTextQualifierDoubleQuote
-
- .TextFileConsecutiveDelimiter = False
-
- .TextFileTabDelimiter = False
-
- .TextFileSemicolonDelimiter = False
-
- .TextFileCommaDelimiter = True
-
- .TextFileSpaceDelimiter = False
-
- .TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, _
-
- 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)
-
- .TextFileTrailingMinusNumbers = True
-
- .Refresh BackgroundQuery:=False
-
- End With
-
- End Sub
-
- 然后根据上面的宏写了如下的delphi代码:
-
<PRE class=csharp name="code"> xlQuery := Excel.worksheets[1].QueryTables.Add('TEXT;'+Edit1.Text,Excel.worksheets[1].Range['A1']);
-
-
-
- xlQuery.FieldNames := True;
-
- xlQuery.RowNumbers := False;
-
- xlQuery.FillAdjacentFormulas := False;
-
- xlQuery.PreserveFormatting := True;
-
- xlQuery.RefreshOnFileOpen := False;
-
-
-
- xlQuery.SavePassword := False;
-
- xlQuery.SaveData := True;
-
- xlQuery.AdjustColumnWidth := True;
-
- xlQuery.RefreshPeriod := 0;
-
- xlQuery.TextFilePromptOnRefresh := False;
-
- xlQuery.TextFilePlatform := 936;
-
- xlQuery.TextFileStartRow := 1;
-
-
-
-
-
- xlQuery.TextFileConsecutiveDelimiter := False;
-
- xlQuery.TextFileTabDelimiter := False;
-
- xlQuery.TextFileSemicolonDelimiter := False;
-
- xlQuery.TextFileCommaDelimiter := True;
-
- xlQuery.TextFileSpaceDelimiter := False;
-
- xlQuery.TextFileColumnDataTypes := A;
-
- xlQuery.TextFileTrailingMinusNumbers := True;
-
- xlQuery.Refresh;</PRE>
- 使用excle的导入功能后转换原来的文件之用了10秒钟。</PRE>
|
请发表评论