delphi--csv,txt文本转换成excel .

最新推荐文章于 2021-12-14 15:13:18 发布

weixin_30429201

最新推荐文章于 2021-12-14 15:13:18 发布

阅读量347

点赞数

文章标签： java

原文链接：http://www.cnblogs.com/hssbsw/archive/2012/12/02/2798322.html

版权

由于系统使用导出的格式是csv，但是如果数字的长度太长的话，用excle打开会用科学技术法自动截断了。所以开发了一个转换程序。

[java] view plain copy print ?

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.

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.

原来使用的是

[csharp] view plain copy print ?

for i:=1 to StepCount do
begin
//Readln(f,s);
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.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;</PRE>
使用excle的导入功能后转换原来的文件之用了10秒钟。</PRE>

转载于:https://www.cnblogs.com/hssbsw/archive/2012/12/02/2798322.html

weixin_30429201

关注

0
点赞
踩
1

收藏

觉得还不错? 一键收藏
0
评论
delphi--csv,txt文本转换成excel .

由于系统使用导出的格式是csv，但是如果数字的长度太长的话，用excle打开会用科学技术法自动截断了。所以开发了一个转换程序。 [java] view plaincopyprint?unitUnit1;interfaceusesWindows,Messages,SysUtils,Variants,Classes,Graphic...
复制链接

扫一扫