about excel转为文本的问题?(100分)

  • 主题发起人 主题发起人 caoliu
  • 开始时间 开始时间
C

caoliu

Unregistered / Unconfirmed
GUEST, unregistred user!
一个EXCEL表中有以下的格式:
china-cell 8613 0.36
china1 86(20,755,591) 0.20
china2 8621(324-327) 0.15

现在怎样转为以下文本格式:
china-cell 8613 0.36
china1 8620 0.20
china1 86755 0.20
china1 86591 0.20
china2 8621324 0.15
china2 8621325 0.15
china2 8621326 0.15
china2 8621327 0.15

大家帮忙呀!
 
给你个例子(要uses ComObj):
var ExcelApp:Variant;
f : System.TextFile; // 文本文件类型
i,j:integer;
s:string;
begin
ExcelApp:=CreateOleObject('Excel.Application');
ExcelApp.workBooks.Open('Excel文件名.xls'); //打开已存在工作簿
//ExcelApp.Worksheets[2].activate; //打开第2个工作表(设置为当前工作表)
//ExcelApp.WorkSheets['第四章'].activate; //打开名为第四章的工作表
//ExcelApp.Cells[1,4].Value:='第一行第四列';
AssignFile(f,'文本文件名.txt');
Rewrite(f);
for i:=1 to 行数 do
begin
s:='';
for j:=1 to 列数 do
s:=s+ExcelApp.Cells[i,j].Value;
Writeln(f,s);// 往文件中写入s的内容
end;
CloseFile(f);
end;
 
你给的例子我知道,但不能解决以下问题:

一个EXCEL表中有以下的格式:
china-cell 8613 0.36
china1 86(20,755,591) 0.20
china2 8621(324-327) 0.15

现在怎样转为以下文本格式:
china-cell 8613 0.36
china1 8620 0.20
china1 86755 0.20
china1 86591 0.20
china2 8621324 0.15
china2 8621325 0.15
china2 8621326 0.15
china2 8621327 0.15
 
既然你不愿写代码,我就给你写了吧,不过没经过测试,相信你会看明白的:
var ExcelApp:Variant;
f : System.TextFile; // 文本文件类型
i,j,k:integer;
s,s1,s2,s3:string;
begin
ExcelApp:=CreateOleObject('Excel.Application');
ExcelApp.workBooks.Open('Excel文件名.xls'); //打开已存在工作簿
AssignFile(f,'文本文件名.txt');
Rewrite(f);
for i:=1 to 行数 do
begin
s:='';
if pos(')',ExcellApp.Cells[i,2].value)=0 then
begin
for j:=1 to 列数 do
s:=s+ExcelApp.Cells[i,j].Value+' ';
Writeln(f,s);// 往文件中写入s的内容
end
else if pos(',',ExcelApp.Cells[i,2].value)<>0 then //处理有逗号的情况
begin
s1:=ExcelApp.Cells[i,2].value;
s:=ExcelApp.Cells[i,1].Value+' '+copy(s1,1,pos('(',s)-1);
delete(s1,1,pos('(',s));
s1:=StringReplace(s1,')','',[]);
while not s1='' do
begin
if pos(',',s1)=0 then
begin
s2:=s1;
s1:='';
end else begin
s2:=copy(s1,1,pos(',',s1)-1);
delete(s1,1,pos(',',s1));
end;
s2:=s+s2+' '+ExcelApp.Cells[i,3].value;
writeln(f,s2);
end;
end
else if pos('-',ExcelApp.Cells[i,2].Value)<>0 then //处理有-号时的情况
begin
s1:=ExcelApp.Cells[i,2].value;
s:=ExcelApp.Cells[i,1].Value+' '+copy(s1,1,pos('(',s));
delete(s1,1,pos('(',s));
s1:=StringReplace(s1,')','',[]);
s2:=copy(s1,1,pos('-',s1)-1);
delete(s1,1,pos('-'));
for k:=strtoint(s2) to strtoint(s1) do
begin
s3:=s+inttostr(k)+' '+ExcellAp.Cells[i,3].value;
writeln(f,s3);
end;
end;
end;
CloseFile(f);
end;
 
这根本不是技术问题!!!虽然我这辈子绝对不会对男人有兴趣,但我发现我一定是"爱"上你了,
如果不是的话我怎么会花了一个钟头做一个根本不是技术问题的问题呢。唉……
我也不知道自己到底是为什么,一个聪明的程序员不会为了这根本换不到一分钱的分数
来这样做吧。。。。。。只希望你拿着有用啦。显然我做得比别人差多了。:)

procedure TForm1.Button1Click(Sender: TObject);
Const
Change : Integer = 2;
ColCount : Integer = 3;
RowCount : Integer = 3;
var
MS : Variant;
Arr : Array [1..3] of Variant; // 最大数3和ColCount一起改动
i,j, K:integer;
S, ChangeCell, AllS, BCell :string;
Procedure ABC;
var
K : Integer;
begin
if Copy(S, Length(S) - 1, 1) <> ',' then
S := S + ',';
While S <> '' do
begin
AllS := '';
For K := 1 to ColCount do
if K <> Change then AllS := AllS + VarToStr(Arr[K]) + ' '
else AllS := AllS + BCell + Copy(S, 1, Pos(',',S) - 1) + ' ';
Memo1.Lines.Add(AllS);
Delete(S,1,Pos(',',s));
end;
AllS := '';
end;
Procedure CDE;
var
Starti, Endi, K, L : Integer;
begin
Try
Starti := StrToInt(Copy(S,1,Pos('-',S) - 1));
Endi := StrToInt(Copy(S,Pos('-',S) + 1, Length(S)));
For L := Starti to Endi do
begin
AllS := '';
For K := 1 to ColCount do
if K <> Change then AllS := AllS + VarToStr(Arr[K]) + ' '
else AllS := AllS + BCell + IntToStr(L) + ' ';
Memo1.Lines.Add(AllS);
end;
AllS := '';
Except
ShowMessage('Error');
end;
end;
begin
Memo1.Clear;
Ms := ExcelApp.ActiveWorkBook.ActiveSheet.Range['B12:D14']; //这里是你的数据区
For I := 1 to RowCount do
begin
AllS := '';
ChangeCell := VarToStr(Ms.Cells[I, 2].Value);
if Pos('(', ChangeCell) <> 0 then
begin
BCell := Copy(ChangeCell,1,Pos('(', ChangeCell) - 1);
s:='';
For J := 1 to ColCount do Arr[J] := VarToStr(Ms.Cells[I, J].Value);
S := Copy(ChangeCell, Pos('(', ChangeCell) + 1,
Pos(')', ChangeCell) - Pos('(', ChangeCell) - 1);
if Pos(',', ChangeCell) <> 0 then ABC
else if Pos('-', ChangeCell) <> 0 then CDE;
end else
For J := 1 to ColCount do
AllS := AllS + VarToStr(Ms.Cells[I, J].Value) + ' ';
if AllS <> '' then Memo1.Lines.Add(AllS);
end;
Memo1.Lines.SaveToFile('C:/OK.txt'); // 这里是你写入的文件名
end;
 
不用谢,我不是冲着分数来的。把分数给上面那位兄弟吧。。。^-^,88。
 
后退
顶部